diff options
Diffstat (limited to 'lib')
426 files changed, 24247 insertions, 7092 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..100be85cac 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 21.3.8">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 21.3.8">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> @@ -662,5 +787,3 @@ </funcs> </erlref> - - diff --git a/lib/common_test/doc/src/ct_master.xml b/lib/common_test/doc/src/ct_master.xml index 2ab421fe9e..f003b7de11 100644 --- a/lib/common_test/doc/src/ct_master.xml +++ b/lib/common_test/doc/src/ct_master.xml @@ -210,7 +210,7 @@ </type> <desc><marker id="run_test-2"/> <p>Tests are spawned on <c>Node</c> using - <seealso marker="ct:run_test-1"><c>ct:run_test/1</c></seealso></p> + <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso></p> </desc> </func> </funcs> diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml index bd9ed21cb4..182abba7ca 100644 --- a/lib/common_test/doc/src/event_handler_chapter.xml +++ b/lib/common_test/doc/src/event_handler_chapter.xml @@ -378,7 +378,7 @@ <note><p>To ensure that printouts to <c>stdout</c> (or printouts made with <seealso marker="ct#log-2"><c>ct:log/2,3</c></seealso> or - <seealso marker="ct:pal-2"><c>ct:pal,2,3</c></seealso>) get written to the test case log + <seealso marker="ct#pal-2"><c>ct:pal,2,3</c></seealso>) get written to the test case log file, and not to the <c>Common Test</c> framework log, you can synchronize with the <c>Common Test</c> server by matching on evvents <c>tc_start</c> and <c>tc_done</c>. In the period between these events, all I/O is directed to the diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index c8e0722a0f..9456b6dbba 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,81 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.17.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> + </list> + </section> + +</section> + +<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 +210,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/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 56f6f7bcc4..2695e597cf 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -1297,7 +1297,7 @@ </taglist> <p>For example, if a test is started with:</p> - <p><c>$ ct_run -suite my_SUITE -logopts no_src</c></p> + <p><c>$ ct_run -suite my_SUITE -logopts no_nl</c></p> <p>then printouts during the test made by successive calls to <c>io:format("x")</c>, appears in the test case log as:</p> <p><c>xxx</c></p> 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 ea7ad8538e..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 @@ -598,11 +598,20 @@ pick_erl_program(L) -> {prog, S} -> S; {release, S} -> + clear_erl_aflags(), find_release(S); this -> ct:get_progname() end. +clear_erl_aflags() -> + %% When starting a node with a previous release, options in + %% ERL_AFLAGS could prevent the node from starting. For example, + %% if ERL_AFLAGS is set to "-emu_type lcnt", the node will only + %% start if the previous release happens to also have a lock + %% counter emulator installed (unlikely). + os:unsetenv("ERL_AFLAGS"). + %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. @@ -656,9 +665,19 @@ find_release({unix,linux}, Rel) -> find_release(_, _) -> none. find_rel_linux(Rel) -> - case suse_release() of - none -> []; - SuseRel -> find_rel_suse(Rel, SuseRel) + try + case ubuntu_release() of + none -> none; + [UbuntuRel |_] -> throw(find_rel_ubuntu(Rel, UbuntuRel)) + end, + case suse_release() of + none -> none; + SuseRel -> throw(find_rel_suse(Rel, SuseRel)) + end, + [] + catch + throw:Result -> + Result end. find_rel_suse(Rel, SuseRel) -> @@ -735,6 +754,93 @@ suse_release(Fd) -> end end. +find_rel_ubuntu(_Rel, UbuntuRel) when is_integer(UbuntuRel), UbuntuRel < 16 -> + []; +find_rel_ubuntu(Rel, UbuntuRel) when is_integer(UbuntuRel) -> + Root = "/usr/local/otp/releases/ubuntu", + lists:foldl(fun (ChkUbuntuRel, Acc) -> + find_rel_ubuntu_aux1(Rel, Root++integer_to_list(ChkUbuntuRel)) + ++ Acc + end, + [], + lists:seq(16, UbuntuRel)). + +find_rel_ubuntu_aux1(Rel, RootWc) -> + case erlang:system_info(wordsize) of + 4 -> + find_rel_ubuntu_aux2(Rel, RootWc++"_32"); + 8 -> + find_rel_ubuntu_aux2(Rel, RootWc++"_64") ++ + find_rel_ubuntu_aux2(Rel, RootWc++"_32") + end. + +find_rel_ubuntu_aux2(Rel, RootWc) -> + RelDir = filename:dirname(RootWc), + Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*", + case file:list_dir(RelDir) of + {ok,Dirs} -> + case lists:filter(fun(Dir) -> + case re:run(Dir, Pat, [unicode]) of + nomatch -> false; + _ -> true + end + end, Dirs) of + [] -> + []; + [R|_] -> + [filename:join([RelDir,R,"bin","erl"])] + end; + _ -> + [] + end. + +ubuntu_release() -> + case file:open("/etc/lsb-release", [read]) of + {ok,Fd} -> + try + ubuntu_release(Fd, undefined, undefined) + after + file:close(Fd) + end; + {error,_} -> none + end. + +ubuntu_release(_Fd, DistrId, Rel) when DistrId /= undefined, + Rel /= undefined -> + Ubuntu = case DistrId of + "Ubuntu" -> true; + "ubuntu" -> true; + _ -> false + end, + case Ubuntu of + false -> none; + true -> Rel + end; +ubuntu_release(Fd, DistroId, Rel) -> + case io:get_line(Fd, '') of + eof -> + none; + Line when is_list(Line) -> + case re:run(Line, "^DISTRIB_ID=(\\w+)$", + [{capture,all_but_first,list}]) of + {match,[NewDistroId]} -> + ubuntu_release(Fd, NewDistroId, Rel); + nomatch -> + case re:run(Line, "^DISTRIB_RELEASE=(\\d+(?:\\.\\d+)*)$", + [{capture,all_but_first,list}]) of + {match,[RelList]} -> + NewRel = lists:map(fun (N) -> + list_to_integer(N) + end, + string:lexemes(RelList, ".")), + ubuntu_release(Fd, DistroId, NewRel); + nomatch -> + ubuntu_release(Fd, DistroId, Rel) + end + end + end. + + unpack(Bin) -> {One,Term} = split_binary(Bin, 1), case binary_to_list(One) of 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_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 7aaf33839f..69a7de1431 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -271,7 +271,7 @@ no_client_hello(Config) -> %% Tell server to receive a get request and then die without %% replying since no hello has been received. (is this correct - %% behavoiur??) + %% behaviour??) ?NS:expect_do(get,close), {error,closed} = ct_netconfc:get(Client,whatever), ok. 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/doc/src/Makefile b/lib/compiler/doc/src/Makefile index 32f150eef8..2fb163b9e7 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -31,6 +31,7 @@ APPLICATION=compiler # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) +COMPILER_DIR = $(ERL_TOP)/lib/compiler/src # ---------------------------------------------------- # Target Specs @@ -38,7 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml -XML_PART_FILES = +XML_PART_FILES = internal.xml XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -49,6 +50,9 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) +XML_INTERNAL_FILES = \ + cerl.xml cerl_trees.xml cerl_clauses.xml + # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -62,6 +66,8 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -85,6 +91,9 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +$(XML_INTERNAL_FILES:%=$(XMLDIR)/%): $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(COMPILER_VSN) -dir $(XMLDIR) $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + debug opt: clean clean_docs: diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml index af6b4cf47a..d101d40cb4 100644 --- a/lib/compiler/doc/src/book.xml +++ b/lib/compiler/doc/src/book.xml @@ -38,6 +38,9 @@ <applications> <xi:include href="ref_man.xml"/> </applications> + <internals> + <xi:include href="internal.xml"/> + </internals> <releasenotes> <xi:include href="notes.xml"/> </releasenotes> diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 5219ba0f5d..549b1049d8 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -632,6 +632,22 @@ module.beam: module.erl \ to be deprecated.</p> </item> + <tag><c>nowarn_removed</c></tag> + <item> + <p>Turns off warnings for calls to functions that have + been removed. Default is to emit warnings for every call + to a function known by the compiler to have been recently + removed from Erlang/OTP.</p> + </item> + + <tag><c>{nowarn_removed, ModulesOrMFAs}</c></tag> + <item> + <p>Turns off warnings for calls to modules or functions + that have been removed. Default is to emit warnings for + every call to a function known by the compiler to have + been recently removed from Erlang/OTP.</p> + </item> + <tag><c>nowarn_obsolete_guard</c></tag> <item> <p>Turns off warnings for calls to old type testing BIFs, diff --git a/lib/compiler/doc/src/internal.xml b/lib/compiler/doc/src/internal.xml new file mode 100644 index 0000000000..f24b363c1c --- /dev/null +++ b/lib/compiler/doc/src/internal.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<internal xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2018</year><year>2018</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>Compiler Internal Documentation</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2018-07-07</date> + <rev>1.0.0</rev> + <file>internal.xml</file> + </header> + <description> + </description> + <xi:include href="cerl.xml"/> + <xi:include href="cerl_trees.xml"/> + <xi:include href="cerl_clauses.xml"/> +</internal> + diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 9f8d63baa1..87b0d345f2 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -194,13 +194,16 @@ $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_ssa.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_bsm.beam: beam_ssa.hrl $(EBIN)/beam_ssa_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_dead.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_funs.beam: beam_ssa.hrl $(EBIN)/beam_ssa_lint.beam: beam_ssa.hrl $(EBIN)/beam_ssa_opt.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_share.beam: beam_ssa.hrl $(EBIN)/beam_ssa_type.beam: beam_ssa.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl 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/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index bad43a9c4e..bf99e8fc26 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -342,21 +342,22 @@ make_save_point_dict_1([], Ctx, I, Acc) -> [{Ctx,I}|Acc]. bs_restores([{L,#b_blk{is=Is,last=Last}}|Bs], CtxChain, D0, Rs0) -> - FPos = case D0 of - #{L:=Pos0} -> Pos0; - #{} -> #{} - end, - {SPos,Rs} = bs_restores_is(Is, CtxChain, FPos, Rs0), - D = bs_update_successors(Last, SPos, FPos, D0), + InPos = maps:get(L, D0, #{}), + {SuccPos, FailPos, Rs} = bs_restores_is(Is, CtxChain, InPos, InPos, Rs0), + + D = bs_update_successors(Last, SuccPos, FailPos, D0), bs_restores(Bs, CtxChain, D, Rs); bs_restores([], _, _, Rs) -> Rs. bs_update_successors(#b_br{succ=Succ,fail=Fail}, SPos, FPos, D) -> join_positions([{Succ,SPos},{Fail,FPos}], D); -bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, _FPos, D) -> +bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, FPos, D) -> + SPos = FPos, %Assertion. Update = [{L,SPos} || {_,L} <- List] ++ [{Fail,SPos}], join_positions(Update, D); -bs_update_successors(#b_ret{}, _, _, D) -> D. +bs_update_successors(#b_ret{}, SPos, FPos, D) -> + SPos = FPos, %Assertion. + D. join_positions([{L,MapPos0}|T], D) -> case D of @@ -382,75 +383,91 @@ join_positions_1(MapPos0, MapPos1) -> end, MapPos1), maps:merge(MapPos0, MapPos2). +%% +%% Updates the restore and position maps according to the given instructions. +%% +%% Note that positions may be updated even when a match fails; if a match +%% requires a restore, the position at the fail block will be the position +%% we've *restored to* and not the one we entered the current block with. +%% + bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], - CtxChain, PosMap0, Rs) -> - PosMap = PosMap0#{Start=>Start}, - bs_restores_is(Is, CtxChain, PosMap, Rs); + CtxChain, SPos0, FPos, Rs) -> + %% We only allow one match per block. + SPos0 = FPos, %Assertion. + SPos = SPos0#{Start=>Start}, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], - CtxChain, PosMap0, Rs0) -> + CtxChain, SPos0, FPos0, Rs0) -> + SPos0 = FPos0, %Assertion. Start = bs_subst_ctx(NewPos, CtxChain), [_,FromPos|_] = Args, - case PosMap0 of + case SPos0 of #{Start:=FromPos} -> %% Same position, no restore needed. - PosMap = case bs_match_type(I) of + SPos = case bs_match_type(I) of plain -> %% Update position to new position. - PosMap0#{Start:=NewPos}; + SPos0#{Start:=NewPos}; _ -> %% Position will not change (test_unit %% instruction or no instruction at %% all). - PosMap0#{Start:=FromPos} + SPos0#{Start:=FromPos} end, - bs_restores_is(Is, CtxChain, PosMap, Rs0); + bs_restores_is(Is, CtxChain, SPos, FPos0, Rs0); #{Start:=_} -> %% Different positions, might need a restore instruction. case bs_match_type(I) of none -> - %% The tail test will be optimized away. - %% No need to do a restore. - PosMap = PosMap0#{Start:=FromPos}, - bs_restores_is(Is, CtxChain, PosMap, Rs0); + %% This is a tail test that will be optimized away. + %% There's no need to do a restore, and all + %% positions are unchanged. + bs_restores_is(Is, CtxChain, SPos0, FPos0, Rs0); test_unit -> %% This match instruction will be replaced by %% a test_unit instruction. We will need a %% restore. The new position will be the position %% restored to (NOT NewPos). - PosMap = PosMap0#{Start:=FromPos}, + SPos = SPos0#{Start:=FromPos}, + FPos = FPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, - bs_restores_is(Is, CtxChain, PosMap, Rs); + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); plain -> %% Match or skip. Position will be changed. - PosMap = PosMap0#{Start:=NewPos}, + SPos = SPos0#{Start:=NewPos}, + FPos = FPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, - bs_restores_is(Is, CtxChain, PosMap, Rs) + bs_restores_is(Is, CtxChain, SPos, FPos, Rs) end end; bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], - CtxChain, PosMap, Rs) -> + CtxChain, SPos, FPos, Rs) -> Start = bs_subst_ctx(FromPos, CtxChain), - #{Start:=FromPos} = PosMap, %Assertion. - bs_restores_is(Is, CtxChain, PosMap, Rs); + #{Start:=FromPos} = SPos, %Assertion. + #{Start:=FromPos} = FPos, %Assertion. + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is], - CtxChain, PosMap0, Rs0) -> - {Rs,PosMap1} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0), - PosMap = bs_invalidate_pos(Args, PosMap1, CtxChain), - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, PosMap0, Rs) -> + CtxChain, SPos0, FPos0, Rs0) -> + {Rs, SPos1, FPos1} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + {SPos, FPos} = bs_invalidate_pos(Args, SPos1, FPos1, CtxChain), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, FPos0, Rs) -> %% We can land here from any point, so all positions are invalid. - PosMap = maps:map(fun(_Start,_Pos) -> unknown end, PosMap0), - bs_restores_is(Is, CtxChain, PosMap, Rs); + Invalidate = fun(_Start,_Pos) -> unknown end, + SPos = maps:map(Invalidate, SPos0), + FPos = maps:map(Invalidate, FPos0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], - CtxChain, PosMap0, Rs0) + CtxChain, SPos0, FPos0, Rs0) when Op =:= bs_test_tail; Op =:= bs_get_tail -> - {Rs,PosMap} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0), - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([_|Is], CtxChain, PosMap, Rs) -> - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([], _CtxChain, PosMap, Rs) -> - {PosMap,Rs}. + {Rs, SPos, FPos} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([_|Is], CtxChain, SPos, FPos, Rs) -> + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([], _CtxChain, SPos, FPos, Rs) -> + {SPos, FPos, Rs}. bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, #b_literal{val=binary},_Flags, @@ -464,40 +481,42 @@ bs_match_type(_) -> %% Call instructions leave the match position in an undefined state, %% requiring us to invalidate each affected argument. -bs_invalidate_pos([#b_var{}=Arg|Args], PosMap0, CtxChain) -> +bs_invalidate_pos([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain) -> Start = bs_subst_ctx(Arg, CtxChain), - case PosMap0 of + case SPos0 of #{Start:=_} -> - PosMap = PosMap0#{Start:=unknown}, - bs_invalidate_pos(Args, PosMap, CtxChain); + SPos = SPos0#{Start:=unknown}, + FPos = FPos0#{Start:=unknown}, + bs_invalidate_pos(Args, SPos, FPos, CtxChain); #{} -> %% Not a match context. - bs_invalidate_pos(Args, PosMap0, CtxChain) + bs_invalidate_pos(Args, SPos0, FPos0, CtxChain) end; -bs_invalidate_pos([_|Args], PosMap, CtxChain) -> - bs_invalidate_pos(Args, PosMap, CtxChain); -bs_invalidate_pos([], PosMap, _CtxChain) -> - PosMap. +bs_invalidate_pos([_|Args], SPos, FPos, CtxChain) -> + bs_invalidate_pos(Args, SPos, FPos, CtxChain); +bs_invalidate_pos([], SPos, FPos, _CtxChain) -> + {SPos, FPos}. -bs_restore_args([#b_var{}=Arg|Args], PosMap0, CtxChain, Dst, Rs0) -> +bs_restore_args([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain, Dst, Rs0) -> Start = bs_subst_ctx(Arg, CtxChain), - case PosMap0 of + case SPos0 of #{Start:=Arg} -> %% Same position, no restore needed. - bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0); + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0); #{Start:=_} -> %% Different positions, need a restore instruction. - PosMap = PosMap0#{Start:=Arg}, + SPos = SPos0#{Start:=Arg}, + FPos = FPos0#{Start:=Arg}, Rs = Rs0#{Dst=>{Start,Arg}}, - bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); #{} -> %% Not a match context. - bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0) + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0) end; -bs_restore_args([_|Args], PosMap, CtxChain, Dst, Rs) -> - bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); -bs_restore_args([], PosMap, _CtxChain, _Dst, Rs) -> - {Rs,PosMap}. +bs_restore_args([_|Args], SPos, FPos, CtxChain, Dst, Rs) -> + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); +bs_restore_args([], SPos, FPos, _CtxChain, _Dst, Rs) -> + {Rs,SPos,FPos}. %% Insert all bs_save and bs_restore instructions. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index efd2be94cb..09a5a6c104 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1604,8 +1604,13 @@ infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> end; infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> fun(Val, S) -> - Type = get_term_type(Val, S), - update_type(fun meet/2,{tuple,[Index],#{ Key => Type }}, Tuple, S) + case is_value_alive(Tuple, S) of + true -> + Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, + update_type(fun meet/2, Type, Tuple, S); + false -> + S + end end; infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> infer_type_test_bif({atom,[]}, Src); @@ -1629,7 +1634,10 @@ infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> infer_type_test_bif({tuple,[0],#{}}, Src); infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + case is_value_alive(Tuple, S) of + true -> update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + false -> S + end; (_, S) -> S end; infer_types_1(_) -> @@ -1637,7 +1645,10 @@ infer_types_1(_) -> infer_type_test_bif(Type, Src) -> fun({atom,true}, S) -> - update_type(fun meet/2, Type, Src, S); + case is_value_alive(Src, S) of + true -> update_type(fun meet/2, Type, Src, S); + false -> S + end; (_, S) -> S end. @@ -2274,6 +2285,9 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> get_raw_type(Src, #vst{}) -> get_literal_type(Src). +is_value_alive(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + is_map_key(Ref, Vs). + get_literal_type(nil=T) -> T; get_literal_type({atom,A}=T) when is_atom(A) -> T; get_literal_type({float,F}=T) when is_float(F) -> T; diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index fce23bfd68..62cd5b5120 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -2157,12 +2157,16 @@ values_arity(Node) -> %% @spec c_binary(Segments::[cerl()]) -> cerl() %% -%% @doc Creates an abstract binary-template. A binary object is a -%% sequence of 8-bit bytes. It is specified by zero or more bit-string -%% template <em>segments</em> of arbitrary lengths (in number of bits), -%% such that the sum of the lengths is evenly divisible by 8. If -%% <code>Segments</code> is <code>[S1, ..., Sn]</code>, the result -%% represents "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the + +%% @doc Creates an abstract binary-template. A binary object is in +%% this context a sequence of an arbitrary number of bits. (The number +%% of bits used to be evenly divisible by 8, but after the +%% introduction of bit strings in the Erlang language, the choice was +%% made to use the binary template for all bit strings.) It is +%% specified by zero or more bit-string template <em>segments</em> of +%% arbitrary lengths (in number of bits). If <code>Segments</code> is +%% <code>[S1, ..., Sn]</code>, the result represents +%% "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the %% <code>Si</code> must have type <code>bitstr</code>. %% %% @see ann_c_binary/2 diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index fa5104c01b..3fd7ddd181 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -14,8 +14,8 @@ %% @author Richard Carlsson <[email protected]> %% @doc Utility functions for Core Erlang case/receive clauses. %% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% <p>Syntax trees are defined in the module +%% <a href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 83a6f0179c..90c796d3d9 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-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. @@ -29,81 +29,82 @@ %% The record definitions appear alphabetically --record(c_alias, {anno=[], var, % var :: Tree, - pat}). % pat :: Tree +-record(c_alias, {anno=[] :: list(), var :: cerl:cerl(), + pat :: cerl:cerl()}). --record(c_apply, {anno=[], op, % op :: Tree, - args}). % args :: [Tree] +-record(c_apply, {anno=[] :: list(), op :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). +-record(c_binary, {anno=[] :: list(), segments :: [cerl:c_bitstr()]}). --record(c_bitstr, {anno=[], val, % val :: Tree, - size, % size :: Tree, - unit, % unit :: Tree, - type, % type :: Tree, - flags}). % flags :: Tree +-record(c_bitstr, {anno=[] :: list(), val :: cerl:cerl(), + size :: cerl:cerl(), + unit :: cerl:cerl(), + type :: cerl:cerl(), + flags :: cerl:cerl()}). --record(c_call, {anno=[], module, % module :: Tree, - name, % name :: Tree, - args}). % args :: [Tree] +-record(c_call, {anno=[] :: list(), module :: cerl:cerl(), + name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_case, {anno=[], arg, % arg :: Tree, - clauses}). % clauses :: [Tree] +-record(c_case, {anno=[] :: list(), arg :: cerl:cerl(), + clauses :: [cerl:cerl()]}). --record(c_catch, {anno=[], body}). % body :: Tree +-record(c_catch, {anno=[] :: list(), body :: cerl:cerl()}). --record(c_clause, {anno=[], pats, % pats :: [Tree], - guard, % guard :: Tree, - body}). % body :: Tree +-record(c_clause, {anno=[] :: list(), pats :: [cerl:cerl()], + guard :: cerl:cerl(), + body :: cerl:cerl() | any()}). % TODO --record(c_cons, {anno=[], hd, % hd :: Tree, - tl}). % tl :: Tree +-record(c_cons, {anno=[] :: list(), hd :: cerl:cerl(), + tl :: cerl:cerl()}). --record(c_fun, {anno=[], vars, % vars :: [Tree], - body}). % body :: Tree +-record(c_fun, {anno=[] :: list(), vars :: [cerl:cerl()], + body :: cerl:cerl()}). --record(c_let, {anno=[], vars, % vars :: [Tree], - arg, % arg :: Tree, - body}). % body :: Tree +-record(c_let, {anno=[] :: list(), vars :: [cerl:cerl()], + arg :: cerl:cerl(), + body :: cerl:cerl()}). --record(c_letrec, {anno=[], defs, % defs :: [#c_def{}], - body}). % body :: Tree +-record(c_letrec, {anno=[] :: list(), + defs :: [{cerl:cerl(), cerl:cerl()}], + body :: cerl:cerl()}). --record(c_literal, {anno=[], val}). % val :: literal() +-record(c_literal, {anno=[] :: list(), val :: any()}). --record(c_map, {anno=[], +-record(c_map, {anno=[] :: list(), arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), es :: [cerl:c_map_pair()], is_pat=false :: boolean()}). --record(c_map_pair, {anno=[], +-record(c_map_pair, {anno=[] :: list(), op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, - key, - val}). + key :: any(), % TODO + val :: any()}). % TODO --record(c_module, {anno=[], name, % name :: Tree, - exports, % exports :: [Tree], - attrs, % attrs :: [#c_def{}], - defs}). % defs :: [#c_def{}] +-record(c_module, {anno=[] :: list(), name :: cerl:cerl(), + exports :: [cerl:cerl()], + attrs :: [{cerl:cerl(), cerl:cerl()}], + defs :: [{cerl:cerl(), cerl:cerl()}]}). --record(c_primop, {anno=[], name, % name :: Tree, - args}). % args :: [Tree] +-record(c_primop, {anno=[] :: list(), name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_receive, {anno=[], clauses, % clauses :: [Tree], - timeout, % timeout :: Tree, - action}). % action :: Tree +-record(c_receive, {anno=[] :: list(), clauses :: [cerl:cerl()], + timeout :: cerl:cerl(), + action :: cerl:cerl()}). --record(c_seq, {anno=[], arg, % arg :: Tree, - body}). % body :: Tree +-record(c_seq, {anno=[] :: list(), arg :: cerl:cerl() | any(), % TODO + body :: cerl:cerl()}). --record(c_try, {anno=[], arg, % arg :: Tree, - vars, % vars :: [Tree], - body, % body :: Tree - evars, % evars :: [Tree], - handler}). % handler :: Tree +-record(c_try, {anno=[] :: list(), arg :: cerl:cerl(), + vars :: [cerl:cerl()], + body :: cerl:cerl(), + evars :: [cerl:cerl()], + handler :: cerl:cerl()}). --record(c_tuple, {anno=[], es}). % es :: [Tree] +-record(c_tuple, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_values, {anno=[], es}). % es :: [Tree] +-record(c_values, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_var, {anno=[], name :: cerl:var_name()}). +-record(c_var, {anno=[] :: list(), name :: cerl:var_name()}). diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index de5a3c2873..6b1438abdd 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,7 @@ map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, receive_stacked/1,aliased_types/1,type_conflict/1, - infer_on_eq/1]). + infer_on_eq/1,infer_dead_value/1]). -include_lib("common_test/include/ct.hrl"). @@ -65,7 +65,7 @@ groups() -> map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, receive_stacked,aliased_types,type_conflict, - infer_on_eq]}]. + infer_on_eq,infer_dead_value]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -679,6 +679,27 @@ infer_on_eq_4(T) -> true = erlang:tuple_size(T) =:= 1, {ok, erlang:element(1, T)}. +%% ERIERL-348; types were inferred for dead values, causing validation to fail. + +infer_dead_value(Config) when is_list(Config) -> + a = idv_1({a, b, c, d, e, f, g}, {0, 0, 0, 0, 0, 0, 0}), + b = idv_1({a, b, c, d, 0, 0, 0}, {a, b, c, d, 0, 0, 0}), + c = idv_1({0, 0, 0, 0, 0, f, g}, {0, 0, 0, 0, 0, f, g}), + error = idv_1(gurka, gaffel), + ok. + +idv_1({_A, _B, _C, _D, _E, _F, _G}, + {0, 0, 0, 0, 0, 0, 0}) -> + a; +idv_1({A, B, C, D,_E, _F, _G}=_Tuple1, + {A, B, C, D, 0, 0, 0}=_Tuple2) -> + b; +idv_1({_A, _B, _C, _D, _E, F, G}, + {0, 0, 0, 0, 0, F, G}) -> + c; +idv_1(_A, _B) -> + error. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 41e4918b1e..d97f49c56e 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -1891,15 +1891,37 @@ expression_before_match_1(R) -> %% Make sure that context positions are updated on calls. restore_on_call(Config) when is_list(Config) -> - ok = restore_on_call_1(<<0, 1, 2>>). + ok = restore_on_call_plain(<<0, 1, 2>>), + <<"x">> = restore_on_call_match(<<0, "x">>), + ok. -restore_on_call_1(<<0, Rest/binary>>) -> - <<2>> = restore_on_call_2(Rest), - <<2>> = restore_on_call_2(Rest), %% {badmatch, <<>>} on missing restore. +restore_on_call_plain(<<0, Rest/binary>>) -> + <<2>> = restore_on_call_plain_1(Rest), + %% {badmatch, <<>>} on missing restore. + <<2>> = restore_on_call_plain_1(Rest), ok. -restore_on_call_2(<<1, Rest/binary>>) -> Rest; -restore_on_call_2(Other) -> Other. +restore_on_call_plain_1(<<1, Rest/binary>>) -> Rest; +restore_on_call_plain_1(Other) -> Other. + +%% Calls a function that moves the match context passed to it, and then matches +%% on its result to confuse the reposition algorithm's success/fail logic. +restore_on_call_match(<<0, Bin/binary>>) -> + case skip_until_zero(Bin) of + {skipped, Rest} -> + Rest; + not_found -> + %% The match context did not get repositioned before the + %% bs_get_tail instruction here. + Bin + end. + +skip_until_zero(<<0,Rest/binary>>) -> + {skipped, Rest}; +skip_until_zero(<<_C,Rest/binary>>) -> + skip_until_zero(Rest); +skip_until_zero(_) -> + not_found. %% 'catch' must invalidate positions. restore_after_catch(Config) when is_list(Config) -> @@ -1983,5 +2005,4 @@ do_matching_meets_apply(_Bin, {Handler, State}) -> %% Another case of the above. Handler:abs(State). - id(I) -> I. diff --git a/lib/crypto/c_src/aead.c b/lib/crypto/c_src/aead.c index 4ed16615a5..ab0e609130 100644 --- a/lib/crypto/c_src/aead.c +++ b/lib/crypto/c_src/aead.c @@ -22,36 +22,65 @@ #include "aes.h" #include "cipher.h" -ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type,Key,Iv,AAD,In) */ + + +ERL_NIF_TERM aead_cipher(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* + (Type,Key,Iv,AAD,In,TagLen,true) + (Type,Key,Iv,AAD,In,Tag,false) + */ #if defined(HAVE_AEAD) const struct cipher_type_t *cipherp; EVP_CIPHER_CTX *ctx = NULL; const EVP_CIPHER *cipher = NULL; - ErlNifBinary key, iv, aad, in; + ErlNifBinary key, iv, aad, in, tag; unsigned int tag_len; - unsigned char *outp, *tagp; - ERL_NIF_TERM type, out, out_tag, ret; - int len, ctx_ctrl_set_ivlen, ctx_ctrl_get_tag, ctx_ctrl_set_tag; + unsigned char *outp, *tagp, *tag_data; + ERL_NIF_TERM type, out, out_tag, ret, encflg_arg; + int len, encflg; + + encflg_arg = argv[6]; + + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (encflg_arg == atom_true) + encflg = 1; + else if (encflg_arg == atom_false) + encflg = 0; + else if (encflg_arg == atom_undefined) + /* For compat funcs in crypto.erl */ + encflg = -1; + else + { + ret = EXCP_BADARG(env, "Bad enc flag"); + goto done; + } type = argv[0]; - ASSERT(argc == 6); - if (!enif_is_atom(env, type)) {ret = EXCP_BADARG(env, "non-atom cipher type"); goto done;} if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) {ret = EXCP_BADARG(env, "non-binary key"); goto done;} - if (!enif_inspect_binary(env, argv[2], &iv)) + if (!enif_inspect_iolist_as_binary(env, argv[2], &iv)) {ret = EXCP_BADARG(env, "non-binary iv"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) - {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) + if (!enif_inspect_iolist_as_binary(env, argv[3], &in)) {ret = EXCP_BADARG(env, "non-binary text"); goto done;} - if (!enif_get_uint(env, argv[5], &tag_len)) - {ret = EXCP_BADARG(env, ""); goto done;} + if (!enif_inspect_iolist_as_binary(env, argv[4], &aad)) + {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} + + if (encflg) { + if (!enif_get_uint(env, argv[5], &tag_len)) + {ret = EXCP_BADARG(env, "Bad Tag length"); goto done;} + tag_data = NULL; + } else { + if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) + {ret = EXCP_BADARG(env, "non-binary Tag"); goto done;} + tag_len = tag.size; + tag_data = tag.data; + } if (tag_len > INT_MAX + || key.size > INT_MAX || iv.size > INT_MAX || in.size > INT_MAX || aad.size > INT_MAX) @@ -66,167 +95,88 @@ ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) if ((cipher = cipherp->cipher.p) == NULL) {ret = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); goto done;} - ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen; - ctx_ctrl_get_tag = cipherp->extra.aead.ctx_ctrl_get_tag; - ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag; - +#if defined(HAVE_GCM_EVP_DECRYPT_BUG) + if ( !encflg && (cipherp->flags & GCM_MODE)) + return aes_gcm_decrypt_NO_EVP(env, argc, argv); +#endif + if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + {ret = EXCP_ERROR(env, "Can't allocate ctx"); goto done;} - if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, encflg) != 1) + {ret = EXCP_ERROR(env, "CipherInit failed"); goto done;} + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) + {ret = EXCP_BADARG(env, "Bad IV length"); goto done;} #if defined(HAVE_CCM) - if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag_len, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (cipherp->flags & CCM_MODE) { + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_tag, (int)tag_len, tag_data) != 1) + {ret = EXCP_BADARG(env, "Can't set tag"); goto done;} + if (EVP_CipherInit_ex(ctx, NULL, NULL, key.data, iv.data, -1) != 1) + {ret = EXCP_BADARG(env, "Can't set key or iv"); goto done;} + if (EVP_CipherUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) + {ret = EXCP_BADARG(env, "Can't set text size"); goto done;} } else #endif { - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherInit_ex(ctx, NULL, NULL, key.data, iv.data, -1) != 1) + {ret = EXCP_BADARG(env, "Can't set key or iv"); goto done;} } - if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) + {ret = EXCP_BADARG(env, "Can't set AAD"); goto done;} if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} - - if (EVP_EncryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - - if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + {ret = EXCP_ERROR(env, "Can't make 'Out' binary"); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, (int)tag_len, tagp) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - - CONSUME_REDS(env, in); - ret = enif_make_tuple2(env, out, out_tag); - - done: - if (ctx) - EVP_CIPHER_CTX_free(ctx); - return ret; - -#else - return EXCP_NOTSUP(env, ""); -#endif -} - -ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type,Key,Iv,AAD,In,Tag) */ -#if defined(HAVE_AEAD) - const struct cipher_type_t *cipherp; - EVP_CIPHER_CTX *ctx = NULL; - const EVP_CIPHER *cipher = NULL; - ErlNifBinary key, iv, aad, in, tag; - unsigned char *outp; - ERL_NIF_TERM type, out, ret; - int len, ctx_ctrl_set_ivlen, ctx_ctrl_set_tag; - - ASSERT(argc == 6); - - type = argv[0]; -#if defined(HAVE_GCM_EVP_DECRYPT_BUG) - if (type == atom_aes_gcm) - return aes_gcm_decrypt_NO_EVP(env, argc, argv); -#endif - - if (!enif_is_atom(env, type)) - {ret = EXCP_BADARG(env, "non-atom cipher type"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) - {ret = EXCP_BADARG(env, "non-binary key"); goto done;} - if (!enif_inspect_binary(env, argv[2], &iv)) - {ret = EXCP_BADARG(env, "non-binary iv"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) - {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) - {ret = EXCP_BADARG(env, ""); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) - {ret = EXCP_BADARG(env, "non-binary text"); goto done;} - - if (tag.size > INT_MAX - || key.size > INT_MAX - || iv.size > INT_MAX - || in.size > INT_MAX - || aad.size > INT_MAX) - {ret = EXCP_BADARG(env, "binary too long"); goto done;} - - if ((cipherp = get_cipher_type(type, key.size)) == NULL) - {ret = EXCP_BADARG(env, "Unknown cipher"); goto done;} - if (cipherp->flags & NON_EVP_CIPHER) - {ret = EXCP_BADARG(env, "Bad cipher"); goto done;} - if ( !(cipherp->flags & AEAD_CIPHER) ) - {ret = EXCP_BADARG(env, "Not aead cipher"); goto done;} - if ((cipher = cipherp->cipher.p) == NULL) - {ret = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); goto done;} + if (EVP_CipherUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) + { + if (encflg) + ret = EXCP_BADARG(env, "Can't set in-text"); + else + /* Decrypt error */ + ret = atom_error; + goto done; + } - ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen; - ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag; + if (encflg) + { + if (EVP_CipherFinal_ex(ctx, outp/*+len*/, &len) != 1) + {ret = EXCP_ERROR(env, "Encrypt error"); goto done;} - if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL) + {ret = EXCP_ERROR(env, "Can't make 'Out' binary"); goto done;} - if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_get_tag, (int)tag_len, tagp) != 1) + {ret = EXCP_ERROR(env, "Can't get Tag"); goto done;} -#if defined(HAVE_CCM) - if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - } + ret = enif_make_tuple2(env, out, out_tag); + } else -#endif { - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - } - - if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - #if defined(HAVE_GCM) - if (type == atom_aes_gcm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1) - goto err; - if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) - goto err; - } + if (cipherp->flags & GCM_MODE) { + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_tag, (int)tag_len, tag.data) != 1) + /* Decrypt error */ + {ret = atom_error; goto done;} + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + /* Decrypt error */ + {ret = atom_error; goto done;} + } #endif - CONSUME_REDS(env, in); - ret = out; - goto done; + ret = out; + } - err: - /* Decrypt failed, that is, wrong tag */ - ret = atom_error; + CONSUME_REDS(env, in); - done: +done: if (ctx) EVP_CIPHER_CTX_free(ctx); return ret; #else - return EXCP_NOTSUP(env, ""); + return EXCP_NOTSUP(env, "Unsupported Cipher"); #endif } + + diff --git a/lib/crypto/c_src/aead.h b/lib/crypto/c_src/aead.h index 54c0711535..2ec7a8a930 100644 --- a/lib/crypto/c_src/aead.h +++ b/lib/crypto/c_src/aead.h @@ -23,7 +23,6 @@ #include "common.h" -ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM aead_cipher(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AEAD_H__ */ diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c index 1d45ed9df2..75cddeb1e9 100644 --- a/lib/crypto/c_src/algorithms.c +++ b/lib/crypto/c_src/algorithms.c @@ -80,8 +80,12 @@ void init_algorithms_types(ErlNifEnv* env) algo_pubkey_cnt = 0; algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa"); +#ifdef HAVE_DSA algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dss"); +#endif +#ifdef HAVE_DH algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dh"); +#endif #if defined(HAVE_EC) #if !defined(OPENSSL_NO_EC2M) algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ec_gf2m"); @@ -251,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/api_ng.c b/lib/crypto/c_src/api_ng.c index 5d063c3ae4..3408ba1b88 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -27,7 +27,7 @@ * */ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #ifdef HAVE_ECB_IVEC_BUG /* <= 0.9.8l returns faulty ivec length */ @@ -93,6 +93,13 @@ static int get_init_args(ErlNifEnv* env, goto err; } + if ((*cipherp)->flags & AEAD_CIPHER) + { + *return_term = EXCP_BADARG(env, "Missing arguments for this cipher"); + goto err; + } + + if (FORBIDDEN_IN_FIPS(*cipherp)) { *return_term = EXCP_NOTSUP(env, "Forbidden in FIPS"); @@ -413,13 +420,15 @@ int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data [, IV]) */ struct evp_cipher_ctx *ctx_res; + struct evp_cipher_ctx ctx_res_copy; ERL_NIF_TERM ret; + ctx_res_copy.ctx = NULL; + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) return EXCP_BADARG(env, "Bad 1:st arg"); if (argc == 3) { - struct evp_cipher_ctx ctx_res_copy; ErlNifBinary ivec_bin; memcpy(&ctx_res_copy, ctx_res, sizeof ctx_res_copy); @@ -474,6 +483,9 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ get_update_args(env, ctx_res, argv[1], &ret); err: + if (ctx_res_copy.ctx) + EVP_CIPHER_CTX_free(ctx_res_copy.ctx); + return ret; /* Both success and error */ } @@ -504,12 +516,17 @@ ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a /* One shot */ /*************************************************************************/ -ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Cipher, Key, IVec, Data, Encrypt) */ struct evp_cipher_ctx ctx_res; const struct cipher_type_t *cipherp; ERL_NIF_TERM ret; + ctx_res.ctx = NULL; +#if !defined(HAVE_EVP_AES_CTR) + ctx_res.env = NULL; +#endif + if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], &cipherp, &ret)) goto ret; @@ -518,10 +535,17 @@ ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ret: if (ctx_res.ctx) EVP_CIPHER_CTX_free(ctx_res.ctx); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res.env) + enif_free_env(ctx_res.env); +#endif + return ret; } -ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) + +ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Cipher, Key, IVec, Data, Encrypt) % if no IV for the Cipher, set IVec = <<>> */ ErlNifBinary data_bin; @@ -536,10 +560,10 @@ ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM /* Run long jobs on a dirty scheduler to not block the current emulator thread */ if (data_bin.size > MAX_BYTES_TO_NIF) { - return enif_schedule_nif(env, "ng_crypto_one_shot", + return enif_schedule_nif(env, "ng_crypto_one_time", ERL_NIF_DIRTY_JOB_CPU_BOUND, - ng_crypto_one_shot, argc, argv); + ng_crypto_one_time, argc, argv); } - return ng_crypto_one_shot(env, argc, argv); + return ng_crypto_one_time(env, argc, argv); } diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h index 5c7d9af3c5..aaf67524ae 100644 --- a/lib/crypto/c_src/api_ng.h +++ b/lib/crypto/c_src/api_ng.h @@ -25,6 +25,6 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AES_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 2652e1db4e..00072af632 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -20,10 +20,10 @@ #include "cipher.h" -#ifdef OPENSSL_NO_DES -#define COND_NO_DES_PTR(Ptr) (NULL) -#else +#ifdef HAVE_DES #define COND_NO_DES_PTR(Ptr) (Ptr) +#else +#define COND_NO_DES_PTR(Ptr) (NULL) #endif static struct cipher_type_t cipher_types[] = @@ -50,39 +50,30 @@ static struct cipher_type_t cipher_types[] = {{"des_ede3_cfb"}, {NULL}, 0, 0}, #endif +#ifdef HAVE_BF {{"blowfish_cbc"}, {&EVP_bf_cbc}, 0, NO_FIPS_CIPHER}, {{"blowfish_cfb64"}, {&EVP_bf_cfb64}, 0, NO_FIPS_CIPHER}, {{"blowfish_ofb64"}, {&EVP_bf_ofb}, 0, NO_FIPS_CIPHER}, {{"blowfish_ecb"}, {&EVP_bf_ecb}, 0, NO_FIPS_CIPHER | ECB_BUG_0_9_8L}, - - {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16, 0}, - {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24, 0}, - {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32, 0}, +#else + {{"blowfish_cbc"}, {NULL}, 0, 0}, + {{"blowfish_cfb64"}, {NULL}, 0, 0}, + {{"blowfish_ofb64"}, {NULL}, 0, 0}, + {{"blowfish_ecb"}, {NULL}, 0, 0}, +#endif {{"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}, @@ -91,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) @@ -117,31 +102,23 @@ static struct cipher_type_t cipher_types[] = #endif #if defined(HAVE_GCM) - {{"aes_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER, {{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, {{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, {{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, {{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, {{0,0,0}}}, - {{"aes_128_gcm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_192_gcm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_256_gcm"}, {NULL}, 32, AEAD_CIPHER, {{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, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER, {{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, {{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, {{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, {{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, {{0,0,0}}}, - {{"aes_128_ccm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_192_ccm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_256_ccm"}, {NULL}, 32, AEAD_CIPHER, {{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}}}, #endif /*==== Specialy handled ciphers, only for inclusion in algorithm's list ====*/ @@ -352,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/cipher.h b/lib/crypto/c_src/cipher.h index b94873940f..0e51c410eb 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -46,6 +46,8 @@ struct cipher_type_t { #define AEAD_CIPHER 8 #define NON_EVP_CIPHER 16 #define AES_CTR_COMPAT 32 +#define CCM_MODE 64 +#define GCM_MODE 128 #ifdef FIPS_SUPPORT diff --git a/lib/crypto/c_src/common.h b/lib/crypto/c_src/common.h index 0bf7f09f4f..a7e59d5d01 100644 --- a/lib/crypto/c_src/common.h +++ b/lib/crypto/c_src/common.h @@ -38,8 +38,11 @@ /* All nif functions return a valid value or throws an exception */ #define EXCP(Env, Id, Str) enif_raise_exception((Env), \ - enif_make_tuple2((Env), \ + enif_make_tuple3((Env), \ (Id), \ + enif_make_tuple2((Env), \ + enif_make_string((Env),__FILE__,(ERL_NIF_LATIN1)), \ + enif_make_int((Env), __LINE__)), \ enif_make_string((Env),(Str),(ERL_NIF_LATIN1)) )) #define EXCP_NOTSUP(Env, Str) EXCP((Env), atom_notsup, (Str)) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 4aed06a489..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}, @@ -81,7 +86,7 @@ static ErlNifFunc nif_funcs[] = { {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0}, {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0}, {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0}, - {"ng_crypto_one_shot_nif", 5, ng_crypto_one_shot_nif, 0}, + {"ng_crypto_one_time_nif", 5, ng_crypto_one_time_nif, 0}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, {"rand_uniform_nif", 2, rand_uniform_nif, 0}, @@ -105,8 +110,7 @@ static ErlNifFunc nif_funcs[] = { {"rand_seed_nif", 1, rand_seed_nif, 0}, - {"aead_encrypt", 6, aead_encrypt, 0}, - {"aead_decrypt", 6, aead_decrypt, 0}, + {"aead_cipher", 7, aead_cipher, 0}, {"poly1305_nif", 2, poly1305_nif, 0}, diff --git a/lib/crypto/c_src/dh.c b/lib/crypto/c_src/dh.c index 38eb534d99..13a2336f25 100644 --- a/lib/crypto/c_src/dh.c +++ b/lib/crypto/c_src/dh.c @@ -23,6 +23,7 @@ ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ +#ifdef HAVE_DH DH *dh_params = NULL; unsigned int mpint; /* 0 or 4 */ ERL_NIF_TERM head, tail; @@ -187,10 +188,14 @@ ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar #endif return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif } ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ +#ifdef HAVE_DH BIGNUM *other_pub_key = NULL; BIGNUM *dh_p = NULL; BIGNUM *dh_g = NULL; @@ -291,4 +296,7 @@ ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg DH_free(dh_priv); return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif } diff --git a/lib/crypto/c_src/dss.c b/lib/crypto/c_src/dss.c index 9bf8eb3ce0..63268f0f2b 100644 --- a/lib/crypto/c_src/dss.c +++ b/lib/crypto/c_src/dss.c @@ -21,6 +21,8 @@ #include "dss.h" #include "bn.h" +#ifdef HAVE_DSA + int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) { /* key=[P,Q,G,KEY] */ @@ -142,3 +144,5 @@ int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) BN_free(dsa_y); return 0; } + +#endif diff --git a/lib/crypto/c_src/dss.h b/lib/crypto/c_src/dss.h index 3275657e98..07e28ca7c5 100644 --- a/lib/crypto/c_src/dss.h +++ b/lib/crypto/c_src/dss.h @@ -23,7 +23,9 @@ #include "common.h" +#ifdef HAVE_DSA int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa); int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa); +#endif #endif /* E_DSS_H__ */ diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index f926f8af13..339eb5b8f4 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -25,9 +25,8 @@ #include <openssl/opensslconf.h> #include <openssl/crypto.h> -#ifndef OPENSSL_NO_DES #include <openssl/des.h> -#endif /* #ifndef OPENSSL_NO_DES */ + /* #include <openssl/idea.h> This is not supported on the openssl OTP requires */ #include <openssl/dsa.h> #include <openssl/rsa.h> @@ -166,6 +165,22 @@ # define HAVE_BLAKE2 #endif +#ifndef OPENSSL_NO_BF +# define HAVE_BF +#endif + +#ifndef OPENSSL_NO_DES +# define HAVE_DES +#endif + +#ifndef OPENSSL_NO_DH +# define HAVE_DH +#endif + +#ifndef OPENSSL_NO_DSA +# define HAVE_DSA +#endif + #ifndef OPENSSL_NO_MD4 # define HAVE_MD4 #endif diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index fd26b7cb5d..c3bd9dfb55 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -160,7 +160,7 @@ static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) { #ifdef OLD - fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD)); + fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", (unsigned long)sizeof(EVP_MD)); if (!MD5_Final(md, data(ctx))) goto err; @@ -404,7 +404,7 @@ int test_rsa_sign(int dtype, } */ if ((sizeof(fake_flag) == m_len) - && bcmp(m,fake_flag,m_len) == 0) { + && memcmp(m,fake_flag,m_len) == 0) { int slen; printf("To be faked\r\n"); @@ -432,7 +432,7 @@ int test_rsa_verify(int dtype, printf("test_rsa_verify (dtype=%i) called m_len=%u siglen=%u\r\n", dtype, m_len, siglen); if ((sizeof(fake_flag) == m_len) - && bcmp(m,fake_flag,m_len) == 0) { + && memcmp(m,fake_flag,m_len) == 0) { int size; if ((size = RSA_size(rsa)) < 0) diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c index 638bb588fa..a1e2677b34 100644 --- a/lib/crypto/c_src/pkey.c +++ b/lib/crypto/c_src/pkey.c @@ -254,7 +254,9 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ { EVP_PKEY *result = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -327,6 +329,7 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { +#ifdef HAVE_DSA if ((dsa = DSA_new()) == NULL) goto err; if (!get_dss_private_key(env, key, dsa)) @@ -340,9 +343,9 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ dsa = NULL; } else { +#endif return PKEY_BADARG; } - goto done; err: @@ -357,8 +360,10 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ enif_free(id); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -377,7 +382,9 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T { EVP_PKEY *result = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -449,6 +456,7 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { +#ifdef HAVE_DSA if ((dsa = DSA_new()) == NULL) goto err; @@ -461,7 +469,9 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T goto err; /* On success, result owns dsa */ dsa = NULL; - +#else + return PKEY_NOTSUP; +#endif } else { return PKEY_BADARG; } @@ -480,8 +490,10 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T enif_free(id); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -518,7 +530,9 @@ ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) unsigned char *tbs; /* data to be signed */ size_t tbslen; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -706,8 +720,10 @@ enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); enif_release_binary(&sig_bin); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -744,7 +760,9 @@ ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[] size_t tbslen; ERL_NIF_TERM ret; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #ifdef HAVE_EC EC_KEY *ec = NULL; #endif @@ -890,8 +908,10 @@ ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[] EVP_PKEY_free(pkey); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -1358,7 +1378,9 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM ret; EVP_PKEY *pkey = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif ERL_NIF_TERM result[8]; ASSERT(argc == 2); @@ -1383,6 +1405,7 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret = enif_make_list_from_array(env, result, 2); +#ifdef HAVE_DSA } else if (argv[0] == atom_dss) { const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL; @@ -1402,7 +1425,7 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM goto err; ret = enif_make_list_from_array(env, result, 4); - +#endif } else if (argv[0] == atom_ecdsa) { #if defined(HAVE_EC) /* not yet implemented @@ -1452,8 +1475,10 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM done: if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif if (pkey) EVP_PKEY_free(pkey); diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile index cbcafb7375..8da494dad6 100644 --- a/lib/crypto/doc/src/Makefile +++ b/lib/crypto/doc/src/Makefile @@ -39,7 +39,8 @@ XML_REF3_FILES = crypto.xml XML_REF6_FILES = crypto_app.xml XML_PART_FILES = usersguide.xml -XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml algorithm_details.xml +XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml \ + algorithm_details.xml new_api.xml BOOK_FILES = book.xml diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 8a4fad67de..d1d1252f29 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -42,7 +42,7 @@ <item> <url href="https://www.nist.gov/publications/sha-3-standard-permutation-based-hash-and-extendable-output-functions?pub_id=919061"> SHA-3 Standard: Permutation-Based Hash and Extendable-Output Functions [FIPS PUB 202] - </url> + </url> </item> <tag>BLAKE2</tag> <item> @@ -190,70 +190,101 @@ </description> <datatypes> - <datatype_title>Ciphers</datatype_title> + <datatype_title>Ciphers, new API</datatype_title> <datatype> <name name="cipher"/> - <name name="stream_cipher"/> - <name name="block_cipher"/> <desc> - <p>Ciphers known byt the CRYPTO application. Note that this list might be reduced if the - underlying libcrypto does not support all of them.</p> </desc> </datatype> - <datatype> - <name name="stream_cipher_iv"/> - <name name="stream_cipher_no_iv"/> + <name name="cipher_no_iv"/> <desc> - <p>Stream ciphers for - <seealso marker="#stream_init-3">stream_init/3</seealso> and - <seealso marker="#stream_init-2">stream_init/2</seealso> . - </p> + </desc> + </datatype> + <datatype> + <name name="cipher_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="cipher_aead"/> + <desc> + <p>Ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-new-api">new API</seealso>.</p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> + <datatype_title>Ciphers, old API</datatype_title> + <datatype> + <name name="block_cipher_with_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="block_cipher_without_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="stream_cipher"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="aead_cipher"/> + <desc> + </desc> + </datatype> <datatype> - <name name="block_cipher_iv"/> <name name="cbc_cipher"/> + <desc> + </desc> + </datatype> + <datatype> <name name="cfb_cipher"/> <desc> - <p>Block ciphers with initialization vector for - <seealso marker="#block_encrypt-4">block_encrypt/4</seealso> and - <seealso marker="#block_decrypt-4">block_decrypt/4</seealso> . - </p> </desc> </datatype> - <datatype> - <name name="alias_cfb"/> - <name name="alias_cbc"/> + <name name="ctr_cipher"/> <desc> - <p>Names that are replaced by more common names. They may deprecated in futer releases.</p> - <p><c>des3_cbc</c> and <c>des_ede3</c> should be replaced by <c>des_ede3_cbc</c></p> - <p><c>des_ede3_cbf</c>, <c>des3_cbf</c> and <c>des3_cfb</c> should be replaced by <c>des_ede3_cfb</c>.</p> - <p><c>aes_cbc128</c> should be replaced by <c>aes_128_cbc</c>.</p> - <p><c>aes_cbc256</c> should be replaced by <c>aes_256_cbc</c>.</p> </desc> </datatype> - <datatype> - <name name="block_cipher_no_iv"/> <name name="ecb_cipher"/> <desc> - <p>Block ciphers without initialization vector for - <seealso marker="#block_encrypt-3">block_encrypt/3</seealso> and - <seealso marker="#block_decrypt-3">block_decrypt/3</seealso> . - </p> + <p>Ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-old-api">old API</seealso>.</p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> <datatype> - <name name="aead_cipher"/> + <name name="retired_cbc_cipher_aliases"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="retired_cfb_cipher_aliases"/> <desc> - <p>Ciphers with simultaneous MAC-calculation or MAC-checking. - <seealso marker="#block_encrypt-4">block_encrypt/4</seealso> and - <seealso marker="#block_decrypt-4">block_decrypt/4</seealso> . + </desc> + </datatype> + <datatype> + <name name="retired_ctr_cipher_aliases"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="retired_ecb_cipher_aliases"/> + <desc> + <p>Alternative, old names of ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-old-api">old API</seealso>. + See <seealso marker="crypto:new_api#retired-cipher-names">Retired cipher names</seealso> for names to + use instead to be prepared for an easy convertion to the + <seealso marker="crypto:new_api#the-new-api">new API</seealso>. </p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> @@ -547,6 +578,7 @@ <name name="stream_state"/> <name name="hmac_state"/> <name name="hash_state"/> + <name name="crypto_state"/> <desc> <p>Contexts with an internal state that should not be manipulated but passed between function calls. </p> @@ -575,117 +607,190 @@ <p>This is a more developed variant of the older <seealso marker="#type-run_time_error">run_time_error()</seealso>. </p> + <p>The exception is:</p> + <pre> + {Tag, {C_FileName,LineNumber}, Description} + + Tag = badarg | notsup | error + C_FileName = string() + LineNumber = integer() + Description = string() + </pre> + <p>It is like the older type an exception of the <c>error</c> class. In addition they contain a descriptive text in English. That text is targeted to a developer. Examples are "Bad key size" or "Cipher id is not an atom". </p> - <p>The exceptions are:</p> + <p>The exception tags are:</p> <taglist> - <tag><c>{badarg, Description::string()}</c></tag> + <tag><c>badarg</c></tag> <item><p>Signifies that one or more arguments are of wrong data type or are otherwise badly formed.</p> </item> - <tag><c>{notsup, Description::string()}</c></tag> + <tag><c>notsup</c></tag> <item><p>Signifies that the algorithm is known but is not supported by current underlying libcrypto or explicitly disabled when building that one.</p> </item> - <tag><c>{error, Description::string()}</c></tag> + <tag><c>error</c></tag> <item><p>An error condition that should not occur, for example a memory allocation failed or the underlying cryptolib returned an error code, for example "Can't initialize context, step 1". Thoose text usually needs searching the C-code to be understood.</p> </item> </taglist> + <p>To catch the exception, use for example:</p> + <code> + try crypto:crypto_init(Ciph, Key, IV, true) + catch + error:{Tag, {C_FileName,LineNumber}, Description} -> + do_something(......) + ..... + end + </code> </desc> </datatype> </datatypes> <!--================ FUNCTIONS ================--> + <section> + <title>New API</title> + </section> + <funcs> <func> - <name name="block_encrypt" arity="3" since="OTP 18.0"/> - <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <name name="crypto_init" arity="3" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions</fsummary> <desc> - <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher.</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>As <seealso marker="#crypto_init/4">crypto_init/4</seealso> but for ciphers without IVs.</p> + </desc> + </func> + + <func> + <name name="crypto_init" arity="4" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Initializes a series of encryptions or decryptions and creates an internal state + with a reference that is returned. + The actual encryption or decryption is done by + <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + </p> + <p>See <seealso marker="crypto:new_api#examples-of-crypto_init-4-and-crypto_update-2"> + examples in the User's Guide.</seealso> </p> </desc> </func> <func> - <name name="block_decrypt" arity="3" since="OTP 18.0"/> - <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> + <name name="crypto_update" arity="2" since="OTP 22.0"/> + <fsummary>Do an actual crypto operation on a part of the full text</fsummary> <desc> - <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher.</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + It does an actual crypto operation on a part of the full text. If the part is less + than a number of full blocks, only the full blocks (possibly none) are encrypted + or decrypted and the remaining bytes are saved to the next <c>crypto_update</c> operation. + The <c>State</c> should be created with + <seealso marker="crypto#crypto_init/3">crypto_init/3</seealso> + or + <seealso marker="crypto#crypto_init/4">crypto_init/4</seealso>. + </p> + <p>See <seealso marker="crypto:new_api#examples-of-crypto_init-4-and-crypto_update-2"> + examples in the User's Guide.</seealso> </p> </desc> </func> <func> - <name since="OTP R16B01">block_encrypt(Type, Key, Ivec, PlainText) -> CipherText | Error</name> - <name since="OTP R16B01">block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag} | Error</name> - <name since="OTP R16B01">block_encrypt(aes_gcm | aes_ccm, Key, Ivec, {AAD, PlainText, TagLength}) -> {CipherText, CipherTag} | Error </name> - <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> - <type> - <v>Type = <seealso marker="#type-block_cipher_iv">block_cipher_iv()</seealso></v> - <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> - <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> - <v>PlainText = iodata()</v> - <v>AAD = IVec = CipherText = CipherTag = binary()</v> - <v>TagLength = 1..16</v> - <v>Error = <seealso marker="#type-run_time_error">run_time_error()</seealso></v> - </type> + <name name="crypto_dyn_iv_init" arity="3" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions where the IV is provided later</fsummary> <desc> - <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher. - <c>IVec</c> is an arbitrary initializing vector.</p> - <p>In AEAD (Authenticated Encryption with Associated Data) mode, encrypt - <c>PlainText</c>according to <c>Type</c> block cipher and calculate - <c>CipherTag</c> that also authenticates the <c>AAD</c> (Associated Authenticated Data).</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths, iv-sizes and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Initializes a series of encryptions or decryptions where the IV is provided later. + The actual encryption or decryption is done by + <seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. </p> </desc> </func> <func> - <name since="OTP R16B01">block_decrypt(Type, Key, Ivec, CipherText) -> PlainText | Error</name> - <name since="OTP R16B01">block_decrypt(AeadType, Key, Ivec, {AAD, CipherText, CipherTag}) -> PlainText | Error</name> - <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> - <type> - <v>Type = <seealso marker="#type-block_cipher_iv">block_cipher_iv()</seealso></v> - <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> - <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> - <v>PlainText = iodata()</v> - <v>AAD = IVec = CipherText = CipherTag = binary()</v> - <v>Error = BadTag | <seealso marker="#type-run_time_error">run_time_error()</seealso></v> - <v>BadTag = error</v> - </type> + <name name="crypto_dyn_iv_update" arity="3" since="OTP 22.0"/> + <fsummary>Do an actual crypto operation on a part of the full text and the IV is supplied for each part</fsummary> <desc> - <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher. - <c>IVec</c> is an arbitrary initializing vector.</p> - <p>In AEAD (Authenticated Encryption with Associated Data) mode, decrypt - <c>CipherText</c>according to <c>Type</c> block cipher and check the authenticity - the <c>PlainText</c> and <c>AAD</c> (Associated Authenticated Data) using the - <c>CipherTag</c>. May return <c>error</c> if the decryption or validation fail's</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths, iv-sizes and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do an actual crypto operation on a part of the full text and the IV is supplied for each part. + The <c>State</c> should be created with + <seealso marker="crypto#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso>. </p> </desc> </func> - <func> + <func> + <name name="crypto_one_time" arity="4" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt of the full text</fsummary> + <desc> + <p>As <seealso marker="#crypto_one_time/5">crypto_one_time/5</seealso> but for ciphers without IVs.</p> + </desc> + </func> + + <func> + <name name="crypto_one_time" arity="5" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt of the full text</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do a complete encrypt or decrypt of the full text in the argument <c>Data</c>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + </p> + <p>See <seealso marker="crypto:new_api#example-of-crypto_one_time-5">examples in the User's Guide.</seealso> + </p> + </desc> + </func> + + <func> + <name name="crypto_one_time_aead" arity="6" since="OTP 22.0"/> + <name name="crypto_one_time_aead" arity="7" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt with an AEAD cipher of the full text</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do a complete encrypt or decrypt with an AEAD cipher of the full text. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c> and set the <c>TagOrTagLength</c> + to the wanted size of the tag, that is, the tag length. If the default length is wanted, the + <c>crypto_aead/6</c> form may be used. + </p> + <p>For decryption, set the <c>EncryptFlag</c> to <c>false</c> and put the tag to be checked + in the argument <c>TagOrTagLength</c>. + </p> + <p>See <seealso marker="crypto:new_api#example-of-crypto_one_time_aead-6">examples in the User's Guide.</seealso> + </p> + </desc> + </func> + + <func> + <name name="supports" arity="1" since="OTP 22.0"/> + <fsummary>Provide a list of available crypto algorithms.</fsummary> + <desc> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying libcrypto library</p> + <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> + for information about the hash and cipher algorithms. + </p> + </desc> + </func> + + </funcs> + + <section> + <title>API kept from previous versions</title> + </section> + + <funcs> + <func> <name name="bytes_to_integer" arity="1" since="OTP R16B01"/> <fsummary>Convert binary representation, of an integer, to an Erlang integer.</fsummary> <desc> @@ -928,7 +1033,7 @@ cipher algorithm in question. </p> <note> - <p>The ciphers <c>aes_cbc</c>, <c>aes_cfb8</c>, <c>aes_cfb128</c>, <c>aes_ctr</c>, + <p>The ciphers <c>aes_cbc</c>, <c>aes_cfb8</c>, <c>aes_cfb128</c>, <c>aes_ctr</c>, <c>aes_ecb</c>, <c>aes_gcm</c> and <c>aes_ccm</c> has no keylength in the <c>Type</c> as opposed to for example <c>aes_128_ctr</c>. They adapt to the length of the key provided in the encrypt and decrypt function. Therefor it is impossible to return a valid keylength @@ -1094,7 +1199,7 @@ <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1120,7 +1225,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1129,7 +1234,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <p> The state returned from this function cannot be used to get a reproducable random sequence as from - the other + the other <seealso marker="stdlib:rand">rand</seealso> functions, since reproducability does not match cryptographically safe. @@ -1160,7 +1265,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <seealso marker="#rand_seed_alg_s-1">rand_seed_alg_s/1</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1227,7 +1332,7 @@ FloatValue = rand:uniform(). % again of 56 bits that makes calculations fast on 64 bit machines. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1248,7 +1353,7 @@ FloatValue = rand:uniform(). % again <p> The state returned from this function cannot be used to get a reproducable random sequence as from - the other + the other <seealso marker="stdlib:rand">rand</seealso> functions, since reproducability does not match cryptographically safe. @@ -1332,68 +1437,6 @@ FloatValue = rand:uniform(). % again </func> <func> - <name name="stream_init" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Initializes the state for use in RC4 stream encryption - <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and - <seealso marker="#stream_decrypt-2">stream_decrypt</seealso></p> - <p>For keylengths see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. - </p> - </desc> - </func> - - <func> - <name name="stream_init" arity="3" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). - <c>Key</c> is the AES key and must be either 128, 192, or 256 bits long. <c>IVec</c> is - an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with - <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and - <seealso marker="#stream_decrypt-2">stream_decrypt</seealso>.</p> - <p>For keylengths and iv-sizes see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. - </p> - </desc> - </func> - - <func> - <name name="stream_encrypt" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Encrypts <c>PlainText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. - <c>Text</c> can be any number of bytes. The initial <c>State</c> is created using - <seealso marker="#stream_init-2">stream_init</seealso>. - <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> - </desc> - </func> - - <func> - <name name="stream_decrypt" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Decrypts <c>CipherText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. - <c>PlainText</c> can be any number of bytes. The initial <c>State</c> is created using - <seealso marker="#stream_init-2">stream_init</seealso>. - <c>NewState</c> must be passed into the next call to <c>stream_decrypt</c>.</p> - </desc> - </func> - - <func> - <name name="supports" arity="0" since="OTP R16B01"/> - <fsummary>Provide a list of available crypto algorithms.</fsummary> - <desc> - <p> Can be used to determine which crypto algorithms that are supported - by the underlying libcrypto library</p> - <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> - for information about the hash and cipher algorithms. - </p> - </desc> - </func> - - <func> <name name="ec_curves" arity="0" since="OTP 17.0"/> <fsummary>Provide a list of available named elliptic curves.</fsummary> <desc> @@ -1440,6 +1483,12 @@ FloatValue = rand:uniform(). % again </desc> </func> + </funcs> + <section> + <title>Engine API</title> + </section> + + <funcs> <!-- Engine functions --> <func> <name name="privkey_to_pubkey" arity="2" since="OTP 20.2"/> @@ -1752,5 +1801,167 @@ FloatValue = rand:uniform(). % again </funcs> +<section> + <title>Old API</title> +</section> + + <funcs> + <func> + <name name="block_encrypt" arity="3" since="OTP 18.0"/> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the-new-api</seealso>.</p></dont> + <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher.</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="block_decrypt" arity="3" since="OTP 18.0"/> + <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher.</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name since="OTP R16B01">block_encrypt(Type, Key, Ivec, PlainText) -> CipherText | Error</name> + <name since="OTP R16B01">block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag} | Error</name> + <name since="OTP R16B01">block_encrypt(aes_gcm | aes_ccm, Key, Ivec, {AAD, PlainText, TagLength}) -> {CipherText, CipherTag} | Error </name> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <type> + <v>Type = <seealso marker="#type-block_cipher_with_iv">block_cipher_with_iv()</seealso></v> + <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> + <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> + <v>PlainText = iodata()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> + <v>TagLength = 1..16</v> + <v>Error = <seealso marker="#type-run_time_error">run_time_error()</seealso></v> + </type> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher. + <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, encrypt + <c>PlainText</c>according to <c>Type</c> block cipher and calculate + <c>CipherTag</c> that also authenticates the <c>AAD</c> (Associated Authenticated Data).</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths, iv-sizes and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name since="OTP R16B01">block_decrypt(Type, Key, Ivec, CipherText) -> PlainText | Error</name> + <name since="OTP R16B01">block_decrypt(AeadType, Key, Ivec, {AAD, CipherText, CipherTag}) -> PlainText | Error</name> + <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> + <type> + <v>Type = <seealso marker="#type-block_cipher_with_iv">block_cipher_with_iv()</seealso></v> + <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> + <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> + <v>PlainText = iodata()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> + <v>Error = BadTag | <seealso marker="#type-run_time_error">run_time_error()</seealso></v> + <v>BadTag = error</v> + </type> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher. + <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, decrypt + <c>CipherText</c>according to <c>Type</c> block cipher and check the authenticity + the <c>PlainText</c> and <c>AAD</c> (Associated Authenticated Data) using the + <c>CipherTag</c>. May return <c>error</c> if the decryption or validation fail's</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths, iv-sizes and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_init" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Initializes the state for use in RC4 stream encryption + <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt-2">stream_decrypt</seealso></p> + <p>For keylengths see the + <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_init" arity="3" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). + <c>Key</c> is the AES key and must be either 128, 192, or 256 bits long. <c>IVec</c> is + an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with + <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt-2">stream_decrypt</seealso>.</p> + <p>For keylengths and iv-sizes see the + <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_encrypt" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Encrypts <c>PlainText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. + <c>Text</c> can be any number of bytes. The initial <c>State</c> is created using + <seealso marker="#stream_init-2">stream_init</seealso>. + <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> + </desc> + </func> + + <func> + <name name="stream_decrypt" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Decrypts <c>CipherText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. + <c>PlainText</c> can be any number of bytes. The initial <c>State</c> is created using + <seealso marker="#stream_init-2">stream_init</seealso>. + <c>NewState</c> must be passed into the next call to <c>stream_decrypt</c>.</p> + </desc> + </func> + + <func> + <name name="supports" arity="0" since="OTP R16B01"/> + <fsummary>Provide a list of available crypto algorithms.</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use + <seealso marker="crypto#supports-1">supports/1</seealso> in + <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying libcrypto library</p> + <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> + for information about the hash and cipher algorithms. + </p> + </desc> + </func> + + </funcs> + </erlref> diff --git a/lib/crypto/doc/src/new_api.xml b/lib/crypto/doc/src/new_api.xml new file mode 100644 index 0000000000..bd2334ac9f --- /dev/null +++ b/lib/crypto/doc/src/new_api.xml @@ -0,0 +1,260 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year><year>2019</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>New and Old API</title> + <prepared>Hans Nilsson</prepared> + <docno></docno> + <date>2019-08-22</date> + <rev>A</rev> + <file>new_api.xml</file> + </header> + <p> + This chapter describes the new api to encryption and decryption. + </p> + + <section> + <title>Background</title> + <p>The CRYPTO app has evolved during its lifetime. Since also the OpenSSL cryptolib has changed the + API several times, there are parts of the CRYPTO app that uses a very old one internally and + other parts that uses the latest one. The internal definitions of e.g cipher names was a bit hard + to maintain. + </p> + <p>It turned out that using the old api in the new way (more about that later), and still keep it + backwards compatible, was not possible. Specially as more precision in the error messages was wanted + it could not be combined with the old standard. + </p> + <p>Therefore the old api (see next section) is kept for now but internally implemented with new primitives. + </p> + </section> + + <section> + <title>The old API</title> + <p>The old functions - not recommended for new programs - are:</p> + <list> + <item><seealso marker="crypto#block_encrypt-3">block_encrypt/3</seealso></item> + <item><seealso marker="crypto#block_encrypt-4">block_encrypt/4</seealso></item> + <item><seealso marker="crypto#block_decrypt-3">block_decrypt/3</seealso></item> + <item><seealso marker="crypto#block_decrypt-4">block_decrypt/4</seealso></item> + <item><seealso marker="crypto#stream_init-2">stream_init/2</seealso></item> + <item><seealso marker="crypto#stream_init-2">stream_init/3</seealso></item> + <item><seealso marker="crypto#stream_encrypt-2">stream_encrypt/2</seealso></item> + <item><seealso marker="crypto#stream_decrypt-2">stream_decrypt/2</seealso></item> + <item><seealso marker="crypto#supports-0">supports/0</seealso></item> + </list> + <p>They are not deprecated for now, but may be in a future release. + </p> + </section> + + <section> + <title>The new API</title> + <p>The new functions for encrypting or decrypting one single binary are: + </p> + <list> + <item><seealso marker="crypto#crypto_one_time/4">crypto_one_time/4</seealso></item> + <item><seealso marker="crypto#crypto_one_time/5">crypto_one_time/5</seealso></item> + <item><seealso marker="crypto#crypto_one_time_aead/6">crypto_one_time_aead/6</seealso></item> + <item><seealso marker="crypto#crypto_one_time_aead/7">crypto_one_time_aead/7</seealso></item> + </list> + <p>In those functions the internal crypto state is first created and initialized + with the cipher type, the key and possibly other data. Then the single binary is encrypted + or decrypted, + the crypto state is de-allocated and the result of the crypto operation is returned. + </p> + <p>The <c>crypto_one_time_aead</c> functions are for the ciphers of mode <c>ccm</c> or + <c>gcm</c>, and for the cipher <c>chacha20-poly1305</c>. + </p> + <p>For repeated encryption or decryption of a text divided in parts, where the internal + crypto state is initialized once, and then many binaries are encrypted or decrypted with + the same state, the functions are: + </p> + <list> + <item><seealso marker="crypto#crypto_init/4">crypto_init/4</seealso></item> + <item><seealso marker="crypto#crypto_init/3">crypto_init/3</seealso></item> + <item><seealso marker="crypto#crypto_update/2">crypto_update/2</seealso></item> + </list> + <p>The <c>crypto_init</c> initialies an internal cipher state, and one or more calls of + <c>crypto_update</c> does the acual encryption or decryption. Note that AEAD ciphers + can't be handled this way due to their nature. + </p> + <p>For repeated encryption or decryption of a text divided in parts where the + same cipher and same key is used, but a new initialization vector (nounce) should be applied + for each part, the functions are: + </p> + <list> + <item><seealso marker="crypto#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso></item> + <item><seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso></item> + </list> + <p>An example of where those functions are needed, is when handling the TLS protocol.</p> + <p>For information about available algorithms, use: + </p> + <list> + <item><seealso marker="crypto#supports-1">supports/1</seealso></item> + <item><seealso marker="crypto#hash_info-1">hash_info/1</seealso></item> + <item><seealso marker="crypto#cipher_info-1">cipher_info/1</seealso></item> + </list> + + <section> + <title>Examples of crypto_init/4 and crypto_update/2</title> + <p>The functions <seealso marker="crypto#crypto_init/4">crypto_init/4</seealso> + and <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso> are intended + to be used for encrypting or decrypting a sequence of blocks. First one call of + <c>crypto_init/4</c> initialises the crypto context. One or more calls <c>crypto_update/2</c> + does the actual encryption or decryption for each block. + </p> + <p>This example shows first the encryption of two blocks and then decryptions of the cipher + text, but divided into three blocks just to show that it is possible to divide the plain text and + cipher text differently for some ciphers:</p> + <code type="erl"> + 1> crypto:start(). + ok + 2> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 3> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 4> StateEnc = crypto:crypto_init(aes_128_ctr, Key, IV, true). % encrypt -> true + #Ref<0.3768901617.1128660993.124047> + 5> crypto:crypto_update(StateEnc, <<"First bytes">>). + <<67,44,216,166,25,130,203,5,66,6,162>> + 6> crypto:crypto_update(StateEnc, <<"Second bytes">>). + <<16,79,94,115,234,197,94,253,16,144,151,41>> + 7> + 7> StateDec = crypto:crypto_init(aes_128_ctr, Key, IV, false). % decrypt -> false + #Ref<0.3768901617.1128660994.124255> + 8> crypto:crypto_update(StateDec, <<67,44,216,166,25,130,203>>). + <<"First b">> + 9> crypto:crypto_update(StateDec, <<5,66,6,162,16,79,94,115,234,197, + 94,253,16,144,151>>). + <<"ytesSecond byte">> + 10> crypto:crypto_update(StateDec, <<41>>). + <<"s">> + 11> + </code> + <p>Note that the internal data that the <c>StateEnc</c> and <c>StateDec</c> references are + destructivly updated by the calls to <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso>. + This is to gain time in the calls of the nifs interfacing the cryptolib. In a loop where the + state is saved in the loop's state, it also saves one update of the loop state per crypto operation. + </p> + <p>For example, a simple server receiving text parts to encrypt and send the result back to the + one who sent them (the <c>Requester</c>): + </p> + <code type="erl"> + encode(Crypto, Key, IV) -> + crypto_loop(crypto:crypto_init(Crypto, Key, IV, true)). + + crypto_loop(State) -> + receive + {Text, Requester} -> + Requester ! crypto:crypto_update(State, Text), + loop(State) + end. + </code> + </section> + + <section> + <title>Example of crypto_one_time/5</title> + <p>The same example as in the + <seealso marker="#examples-of-crypto_init-4-and-crypto_update-2">previous section</seealso>, + but now with one call to <seealso marker="crypto#crypto_one_time/5">crypto_one_time/5</seealso>: + </p> + <code> + 1> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 2> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 3> Txt = [<<"First bytes">>,<<"Second bytes">>]. + [<<"First bytes">>,<<"Second bytes">>] + 4> crypto:crypto_one_time(aes_128_ctr, Key, IV, Txt, true). + <<67,44,216,166,25,130,203,5,66,6,162,16,79,94,115,234, + 197,94,253,16,144,151,41>> + 5> + </code> + <p>The <c>[<<"First bytes">>,<<"Second bytes">>]</c> could of course have been one + single binary: <c><<"First bytesSecond bytes">></c>. + </p> + </section> + + <section> + <title>Example of crypto_one_time_aead/6</title> + <p>The same example as in the + <seealso marker="#example-of-crypto_one_time-5">previous section</seealso>, + but now with one call to <seealso marker="crypto#crypto_one_time_aead/6">crypto_one_time_aead/6</seealso>: + </p> + <code> + 1> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 2> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 3> Txt = [<<"First bytes">>,<<"Second bytes">>]. + [<<"First bytes">>,<<"Second bytes">>] + 4> AAD = <<"Some bytes">>. + <<"Some bytes">> + 5> crypto:crypto_one_time_aead(aes_128_gcm, Key, IV, Txt, AAD, true). + {<<240,130,38,96,130,241,189,52,3,190,179,213,132,1,72, + 192,103,176,90,104,15,71,158>>, + <<131,47,45,91,142,85,9,244,21,141,214,71,31,135,2,155>>} + 9> + </code> + <p>The <c>[<<"First bytes">>,<<"Second bytes">>]</c> could of course have been one + single binary: <c><<"First bytesSecond bytes">></c>. + </p> + </section> + + </section> + + <section> + <title>Retired cipher names</title> + <p>This table lists the retired cipher names in the first column and suggests names to replace them with + in the second column. + </p> + <p>The new names follows the OpenSSL libcrypto names. The format is ALGORITM_KEYSIZE_MODE. + </p> + <p>Examples of algorithms are aes, chacha20 and des. The keysize is the number of bits + and examples of the mode are cbc, ctr and gcm. The mode may be followed by a number depending + on the mode. An example is the ccm mode which has a variant called ccm8 where the so called tag + has a length of eight bits. + </p> + <p>The old names had by time lost any common naming which the new names now introduces. The new names include + the key length which improves the error checking in the lower levels of the crypto application. + </p> + + <table> + <row><cell><strong>Instead of:</strong></cell> <cell><strong>Use:</strong> </cell></row> + + <row><cell><c>aes_cbc128</c> </cell> <cell> <c>aes_128_cbc</c> </cell></row> + <row><cell><c>aes_cbc256</c> </cell> <cell> <c>aes_256_cbc</c> </cell></row> + <row><cell><c>aes_cbc</c> </cell> <cell> <c>aes_128_cbc, aes_192_cbc, aes_256_cbc</c></cell></row> + <row><cell><c>aes_ccm</c> </cell> <cell> <c>aes_128_ccm, aes_192_ccm, aes_256_ccm</c></cell></row> + <row><cell><c>aes_cfb128</c> </cell> <cell> <c>aes_128_cfb128, aes_192_cfb128, aes_256_cfb128</c></cell></row> + <row><cell><c>aes_cfb8</c> </cell> <cell> <c>aes_128_cfb8, aes_192_cfb8, aes_256_cfb8</c></cell></row> + <row><cell><c>aes_ctr</c> </cell> <cell> <c>aes_128_ctr, aes_192_ctr, aes_256_ctr</c></cell></row> + <row><cell><c>aes_gcm</c> </cell> <cell> <c>aes_128_gcm, aes_192_gcm, aes_256_gcm</c></cell></row> + <row><cell><c>des3_cbc</c> </cell> <cell> <c>des_ede3_cbc</c></cell></row> + <row><cell><c>des3_cbf</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <row><cell><c>des3_cfb</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <row><cell><c>des_ede3</c> </cell> <cell> <c>des_ede3_cbc</c></cell></row> + <row><cell><c>des_ede3_cbf</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <tcaption></tcaption> + </table> + </section> + +</chapter> 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/doc/src/usersguide.xml b/lib/crypto/doc/src/usersguide.xml index 2dfc966609..134f900d4c 100644 --- a/lib/crypto/doc/src/usersguide.xml +++ b/lib/crypto/doc/src/usersguide.xml @@ -51,4 +51,5 @@ <xi:include href="engine_load.xml"/> <xi:include href="engine_keys.xml"/> <xi:include href="algorithm_details.xml"/> + <xi:include href="new_api.xml"/> </part> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index fd13481951..8ffdde2b90 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -58,9 +58,11 @@ %% New interface -export([crypto_init/4, crypto_init/3, crypto_update/2, - crypto_one_shot/5, - crypto_init_dyn_iv/3, - crypto_update_dyn_iv/3 + 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, + supports/1 ]). @@ -276,48 +278,153 @@ -type edwards_curve_ed() :: ed25519 | ed448 . -%%% --type cipher() :: block_cipher() - | stream_cipher() - | aead_cipher() . +%%%---------------------------------------------------------------- +%%% New cipher schema +%%% +-type cipher() :: cipher_no_iv() + | cipher_iv() + | cipher_aead() . --type block_cipher() :: block_cipher_iv() | block_cipher_no_iv() . +-type cipher_no_iv() :: aes_128_ecb + | aes_192_ecb + | aes_256_ecb --type block_cipher_iv() :: cbc_cipher() - | cfb_cipher() - | aes_ige256 - | blowfish_ofb64 - | rc2_cbc . + | blowfish_ecb + | des_ecb + | rc4 . --type cbc_cipher() :: des_cbc | des_ede3_cbc - | blowfish_cbc - | aes_cbc | aes_128_cbc | aes_192_cbc | aes_256_cbc - | alias_cbc() . --type alias_cbc() :: des3_cbc | des_ede3 - | aes_cbc128 | aes_cbc256 . +-type cipher_iv() :: aes_128_cbc + | aes_192_cbc + | aes_256_cbc + + | aes_128_cfb128 + | aes_192_cfb128 + | aes_256_cfb128 + + | aes_128_cfb8 + | aes_192_cfb8 + | aes_256_cfb8 + + | aes_128_ctr + | aes_192_ctr + | aes_256_ctr + + | aes_ige256 --type aead_cipher() :: aes_gcm + | blowfish_cbc + | blowfish_cfb64 + | blowfish_ofb64 + | chacha20 + | des_ede3_cbc + | des_ede3_cfb + + | des_cbc + | des_cfb + | rc2_cbc . + + +-type cipher_aead() :: aes_128_ccm + | aes_192_ccm + | aes_256_ccm + | aes_128_gcm | aes_192_gcm | aes_256_gcm - | aes_ccm - | aes_128_ccm - | aes_192_ccm - | aes_256_ccm + | chacha20_poly1305 . --type cfb_cipher() :: aes_cfb8 - | aes_cfb128 - | blowfish_cfb64 - | des_cfb - | des_ede3_cfb - | alias_cfb() . --type alias_cfb() :: des_ede3_cbf | des3_cbf - | des3_cfb . +%% -type retired_cipher_no_iv_aliases() :: aes_ecb . + +%% -type retired_cipher_iv_aliases() :: aes_cbc +%% | aes_cbc128 % aes_128_cbc +%% | aes_cbc256 % aes_256_cbc +%% | aes_cfb128 +%% | aes_cfb8 +%% | aes_ctr +%% | des3_cbc % des_ede3_cbc +%% | des_ede3 % des_ede3_cbc +%% | des_ede3_cbf % des_ede3_cfb +%% | des3_cbf % des_ede3_cfb +%% | des3_cfb . % des_ede3_cfb + +%% -type retired_cipher_aead_aliases() :: aes_ccm +%% | aes_gcm . --type block_cipher_no_iv() :: ecb_cipher() . --type ecb_cipher() :: des_ecb | blowfish_ecb | aes_ecb . +%%%---------------------------------------------------------------- +%%% Old cipher scheme +%%% +%%% +-type block_cipher_without_iv() :: ecb_cipher() . + +-type block_cipher_with_iv() :: cbc_cipher() + | cfb_cipher() + | blowfish_ofb64 + | aes_ige256 . + +-type stream_cipher() :: ctr_cipher() + | chacha20 + | rc4 . + + +%%%---- +-type cbc_cipher() :: aes_128_cbc + | aes_192_cbc + | aes_256_cbc + | blowfish_cbc + | des_cbc + | des_ede3_cbc + | rc2_cbc + | retired_cbc_cipher_aliases() . + +-type retired_cbc_cipher_aliases() :: aes_cbc % aes_*_cbc + | aes_cbc128 % aes_128_cbc + | aes_cbc256 % aes_256_cbc + | des3_cbc % des_ede3_cbc + | des_ede3 . % des_ede3_cbc + +%%%---- +-type cfb_cipher() :: aes_128_cfb128 + | aes_192_cfb128 + | aes_256_cfb128 + | aes_128_cfb8 + | aes_192_cfb8 + | aes_256_cfb8 + | blowfish_cfb64 + | des_cfb + | des_ede3_cfb + | retired_cfb_cipher_aliases() . + +-type retired_cfb_cipher_aliases() :: aes_cfb8 % aes_*_cfb8 + | aes_cfb128 % aes_*_cfb128 + | des3_cbf % des_ede3_cfb, cfb misspelled + | des3_cfb % des_ede3_cfb + | des_ede3_cbf .% cfb misspelled + + +%%%---- +-type ctr_cipher() :: aes_128_ctr + | aes_192_ctr + | aes_256_ctr + | retired_ctr_cipher_aliases() . + +-type retired_ctr_cipher_aliases() :: aes_ctr . % aes_*_ctr + +%%%---- +-type ecb_cipher() :: aes_128_ecb + | aes_192_ecb + | aes_256_ecb + | blowfish_ecb + | retired_ecb_cipher_aliases() . + +-type retired_ecb_cipher_aliases() :: aes_ecb . + +%%%---- +-type aead_cipher() :: aes_gcm | aes_ccm | chacha20_poly1305 . + + +%%%----- end old cipher schema ------------------------------------ +%%%---------------------------------------------------------------- -type key() :: iodata(). -type des3_key() :: [key()]. @@ -393,15 +500,43 @@ 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()} + ]. + + +-spec supports(Type) -> Support + when Type :: hashs + | ciphers + | public_keys + | macs + | curves + | rsa_opts, + Support :: Hashs + | Ciphers + | PKs + | Macs + | Curves + | RSAopts, + Hashs :: [sha1() | sha2() | sha3() | blake2() | ripemd160 | compatibility_only_hash()], + Ciphers :: [cipher()], + PKs :: [rsa | dss | ecdsa | dh | ecdh | ec_gf2m], + Macs :: [hmac | cmac | poly1305], + Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()], + RSAopts :: [rsa_sign_verify_opt() | rsa_opt()] . + +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(), @@ -564,9 +699,9 @@ poly1305(Key, Data) -> -define(COMPAT(CALL), try begin CALL end catch - error:{error,_} -> + error:{error, {_File,_Line}, _Reason} -> error(badarg); - error:{E,_Reason} when E==notsup ; E==badarg -> + error:{E, {_File,_Line}, _Reason} when E==notsup ; E==badarg -> error(E) end). @@ -594,7 +729,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) -> @@ -603,15 +738,42 @@ 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)). %%%---- Block ciphers %%%---------------------------------------------------------------- --spec block_encrypt(Type::block_cipher_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> +-spec block_encrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> binary() | run_time_error(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata()}) -> {binary(), binary()} | run_time_error(); @@ -627,34 +789,24 @@ block_encrypt(Type, Key0, Ivec, Data) -> ?COMPAT( case Data of {AAD, PlainText} -> - aead_encrypt(alias(Type,Key), Key, Ivec, AAD, PlainText, aead_tag_len(Type)); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, PlainText, AAD, true); {AAD, PlainText, TagLength} -> - aead_encrypt(alias(Type,Key), Key, Ivec, AAD, PlainText, TagLength); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, PlainText, AAD, TagLength, true); PlainText -> - crypto_one_shot(alias(Type,Key), Key, Ivec, PlainText, true) + crypto_one_time(alias(Type,Key), Key, Ivec, PlainText, true) end). --spec block_encrypt(Type::block_cipher_no_iv(), Key::key(), PlainText::iodata()) -> +-spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary() | run_time_error(). block_encrypt(Type, Key0, PlainText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_shot(alias(Type,Key), Key, <<>>, PlainText, true)). + ?COMPAT(crypto_one_time(alias(Type,Key), Key, PlainText, true)). -aead_tag_len(chacha20_poly1305) -> 16; -aead_tag_len(aes_ccm) -> 12; -aead_tag_len(aes_128_ccm) -> 12; -aead_tag_len(aes_192_ccm) -> 12; -aead_tag_len(aes_256_ccm) -> 12; -aead_tag_len(aes_gcm) -> 16; -aead_tag_len(aes_128_gcm) -> 16; -aead_tag_len(aes_192_gcm) -> 16; -aead_tag_len(aes_256_gcm) -> 16. - %%%---------------------------------------------------------------- %%%---------------------------------------------------------------- --spec block_decrypt(Type::block_cipher_iv(), Key::key()|des3_key(), Ivec::binary(), Data::iodata()) -> +-spec block_decrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), Data::iodata()) -> binary() | run_time_error(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), Tag::binary()}) -> @@ -668,18 +820,18 @@ block_decrypt(Type, Key0, Ivec, Data) -> ?COMPAT( case Data of {AAD, CryptoText, Tag} -> - aead_decrypt(alias(Type,Key), Key, Ivec, AAD, CryptoText, Tag); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, CryptoText, AAD, Tag, false); CryptoText -> - crypto_one_shot(alias(Type,Key), Key, Ivec, CryptoText, false) + crypto_one_time(alias(Type,Key), Key, Ivec, CryptoText, false) end). --spec block_decrypt(Type::block_cipher_no_iv(), Key::key(), Data::iodata()) -> +-spec block_decrypt(Type::block_cipher_without_iv(), Key::key(), Data::iodata()) -> binary() | run_time_error(). block_decrypt(Type, Key0, CryptoText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_shot(alias(Type,Key), Key, <<>>, CryptoText, false)). + ?COMPAT(crypto_one_time(alias(Type,Key), Key, CryptoText, false)). %%%-------- Stream ciphers API @@ -687,17 +839,9 @@ block_decrypt(Type, Key0, CryptoText) -> crypto_state() | {crypto_state(),flg_undefined} }. --type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . --type stream_cipher_no_iv() :: rc4 . --type stream_cipher_iv() :: aes_ctr - | aes_128_ctr - | aes_192_ctr - | aes_256_ctr - | chacha20 . - %%%---- stream_init -spec stream_init(Type, Key, IVec) -> State | run_time_error() - when Type :: stream_cipher_iv(), + when Type :: stream_cipher(), Key :: iodata(), IVec ::binary(), State :: stream_state() . @@ -711,7 +855,7 @@ stream_init(Type, Key0, IVec) when is_binary(IVec) -> -spec stream_init(Type, Key) -> State | run_time_error() - when Type :: stream_cipher_no_iv(), + when Type :: rc4, Key :: iodata(), State :: stream_state() . stream_init(rc4 = Type, Key0) -> @@ -792,38 +936,35 @@ next_iv(Type, Data, _Ivec) -> %%% -spec crypto_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() - when Cipher :: block_cipher_no_iv() - | stream_cipher_no_iv(), + when Cipher :: cipher_no_iv(), Key :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . crypto_init(Cipher, Key, EncryptFlag) -> %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), <<>>, EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), <<>>, EncryptFlag). -spec crypto_init(Cipher, Key, IV, EncryptFlag) -> State | descriptive_error() - when Cipher :: stream_cipher_iv() - | block_cipher_iv(), + when Cipher :: cipher_iv(), Key :: iodata(), IV :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . crypto_init(Cipher, Key, IV, EncryptFlag) -> - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). %%%---------------------------------------------------------------- --spec crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> State | descriptive_error() - when Cipher :: stream_cipher_iv() - | block_cipher_iv(), +-spec crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() + when Cipher :: cipher_iv(), Key :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . -crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> +crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), undefined, EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), undefined, EncryptFlag). %%%---------------------------------------------------------------- %%% @@ -846,12 +987,12 @@ crypto_update(State, Data0) -> %%%---------------------------------------------------------------- --spec crypto_update_dyn_iv(State, Data, IV) -> Result | descriptive_error() +-spec crypto_dyn_iv_update(State, Data, IV) -> Result | descriptive_error() when State :: crypto_state(), Data :: iodata(), IV :: iodata(), Result :: binary() . -crypto_update_dyn_iv(State, Data0, IV) -> +crypto_dyn_iv_update(State, Data0, IV) -> %% When State is from State = crypto_init(Cipher, Key, undefined, EncryptFlag) case iolist_to_binary(Data0) of <<>> -> @@ -866,29 +1007,86 @@ crypto_update_dyn_iv(State, Data0, IV) -> %%% The size must be an integer multiple of the crypto's blocksize. %%% --spec crypto_one_shot(Cipher, Key, IV, Data, EncryptFlag) -> +-spec crypto_one_time(Cipher, Key, Data, EncryptFlag) -> Result | descriptive_error() - when Cipher :: stream_cipher() - | block_cipher(), + when Cipher :: cipher_no_iv(), Key :: iodata(), - IV :: iodata() | undefined, Data :: iodata(), EncryptFlag :: boolean(), Result :: binary() . -crypto_one_shot(Cipher, Key, undefined, Data, EncryptFlag) -> - crypto_one_shot(Cipher, Key, <<>>, Data, EncryptFlag); +crypto_one_time(Cipher, Key, Data, EncryptFlag) -> + crypto_one_time(Cipher, Key, <<>>, Data, EncryptFlag). + +-spec crypto_one_time(Cipher, Key, IV, Data, EncryptFlag) -> + Result | descriptive_error() + when Cipher :: cipher_iv(), + Key :: iodata(), + IV :: iodata(), + Data :: iodata(), + EncryptFlag :: boolean(), + Result :: binary() . -crypto_one_shot(Cipher, Key, IV, Data0, EncryptFlag) -> +crypto_one_time(Cipher, Key, IV, Data0, EncryptFlag) -> case iolist_to_binary(Data0) of <<>> -> <<>>; % Known to fail on OpenSSL 0.9.8h Data -> - ng_crypto_one_shot_nif(alias(Cipher), + ng_crypto_one_time_nif(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), Data, EncryptFlag) end. + +-spec crypto_one_time_aead(Cipher, Key, IV, InText, AAD, EncFlag::true) -> + Result | descriptive_error() + when Cipher :: cipher_aead(), + Key :: iodata(), + IV :: iodata(), + InText :: iodata(), + AAD :: iodata(), + Result :: EncryptResult, + EncryptResult :: {OutCryptoText, OutTag}, + OutCryptoText :: binary(), + OutTag :: binary(). + +crypto_one_time_aead(Cipher, Key, IV, PlainText, AAD, true) -> + crypto_one_time_aead(Cipher, Key, IV, PlainText, AAD, aead_tag_len(Cipher), true). + + +-spec crypto_one_time_aead(Cipher, Key, IV, InText, AAD, TagOrTagLength, EncFlag) -> + Result | descriptive_error() + when Cipher :: cipher_aead(), + Key :: iodata(), + IV :: iodata(), + InText :: iodata(), + AAD :: iodata(), + TagOrTagLength :: EncryptTagLength | DecryptTag, + EncryptTagLength :: non_neg_integer(), % or pos_integer() 1.. + DecryptTag :: iodata(), + EncFlag :: boolean(), + Result :: EncryptResult | DecryptResult, + EncryptResult :: {OutCryptoText, OutTag}, + DecryptResult :: OutPlainText | error, + OutCryptoText :: binary(), + OutTag :: binary(), + OutPlainText :: binary(). + +crypto_one_time_aead(Cipher, Key, IV, TextIn, AAD, TagOrTagLength, EncFlg) -> + aead_cipher(Cipher, Key, IV, TextIn, AAD, TagOrTagLength, EncFlg). + + +aead_tag_len(chacha20_poly1305) -> 16; +aead_tag_len(aes_ccm ) -> 12; +aead_tag_len(aes_128_ccm) -> 12; +aead_tag_len(aes_192_ccm) -> 12; +aead_tag_len(aes_256_ccm) -> 12; +aead_tag_len(aes_gcm ) -> 16; +aead_tag_len(aes_128_gcm) -> 16; +aead_tag_len(aes_192_gcm) -> 16; +aead_tag_len(aes_256_gcm) -> 16; +aead_tag_len(_) -> error({badarg, "Not an AEAD cipher"}). + %%%---------------------------------------------------------------- %%% NIFs @@ -909,15 +1107,42 @@ ng_crypto_update_nif(_State, _Data) -> ?nif_stub. ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. --spec ng_crypto_one_shot_nif(atom(), binary(), binary(), binary(), boolean() ) -> +-spec ng_crypto_one_time_nif(atom(), binary(), binary(), binary(), boolean() ) -> binary() | descriptive_error(). -ng_crypto_one_shot_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. +ng_crypto_one_time_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. %%%---------------------------------------------------------------- %%% Cipher aliases %%% -prepend_cipher_aliases(L) -> - [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. +-define(if_also(Cipher, Ciphers, AliasCiphers), + case lists:member(Cipher, Ciphers) of + true -> + AliasCiphers; + false -> + 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 alias(des3_cbc) -> des_ede3_cbc; @@ -933,42 +1158,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). -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_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_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_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_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_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_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_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_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_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_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_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(Alg, _) -> Alg. +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; + +alias2(Alg, _) -> Alg. %%%================================================================ %%% @@ -2060,8 +2280,7 @@ cipher_info_nif(_Type) -> ?nif_stub. %% AES - in Galois/Counter Mode (GCM) %% %% The default tag length is EVP_GCM_TLS_TAG_LEN(16), -aead_encrypt(_Type, _Key, _Ivec, _AAD, _In, _TagLength) -> ?nif_stub. -aead_decrypt(_Type, _Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. +aead_cipher(_Type, _Key, _Ivec, _AAD, _In, _TagOrTagLength, _EncFlg) -> ?nif_stub. %% %% AES - with 256 bit key in infinite garble extension mode (IGE) @@ -2233,7 +2452,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 ce5097de47..56691223c4 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -45,6 +45,42 @@ all() -> hash_info ]. +-define(NEW_CIPHER_TYPE_SCHEMA, + {group, des_ede3_cbc}, + {group, des_ede3_cfb}, + {group, aes_128_cbc}, + {group, aes_192_cbc}, + {group, aes_256_cbc}, + {group, aes_128_ctr}, + {group, aes_192_ctr}, + {group, aes_256_ctr}, + {group, aes_128_ccm}, + {group, aes_192_ccm}, + {group, aes_256_ccm}, + {group, aes_128_ecb}, + {group, aes_192_ecb}, + {group, aes_256_ecb}, + {group, aes_128_gcm}, + {group, aes_192_gcm}, + {group, aes_256_gcm}, + {group, des_ede3_cbc}, + {group, des_ede3_cfb} + ). + +-define(RETIRED_TYPE_ALIASES, + {group, aes_cbc}, + {group, aes_cbc128}, + {group, aes_cbc256}, + {group, aes_ccm}, + {group, aes_ctr}, + {group, aes_gcm}, + {group, aes_ecb}, + {group, des3_cfb}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, des_ede3} + ). + groups() -> [{non_fips, [], [ {group, blake2b}, @@ -67,35 +103,35 @@ groups() -> {group, sha3_512}, {group, sha512}, {group, sha}, + {group, poly1305}, {group, dh}, {group, ecdh}, {group, srp}, - {group, aes_cbc}, - {group, aes_ccm}, - {group, aes_gcm}, {group, chacha20_poly1305}, {group, chacha20}, - {group, des3_cfb}, - {group, aes_cbc128}, - {group, aes_cbc256}, - {group, aes_cfb128}, - {group, aes_cfb8}, - {group, aes_ctr}, - {group, aes_ige256}, {group, blowfish_cbc}, {group, blowfish_cfb64}, {group, blowfish_ecb}, {group, blowfish_ofb64}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, aes_ige256}, {group, des_cbc}, {group, des_cfb}, - {group, des_ede3}, - {group, poly1305}, {group, rc2_cbc}, - {group, rc4} + {group, rc4}, + + ?NEW_CIPHER_TYPE_SCHEMA, + {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}, @@ -114,123 +150,148 @@ groups() -> {group, sha256}, {group, sha384}, {group, sha512}, + {group, no_poly1305}, {group, dh}, {group, ecdh}, {group, no_srp}, - {group, aes_cbc}, - {group, aes_ccm}, - {group, aes_gcm}, {group, no_chacha20_poly1305}, {group, no_chacha20}, - {group, des3_cfb}, - {group, aes_cbc128}, - {group, aes_cbc256}, - {group, no_aes_cfb128}, - {group, no_aes_cfb8}, - {group, aes_ctr}, - {group, no_aes_ige256}, {group, no_blowfish_cbc}, {group, no_blowfish_cfb64}, {group, no_blowfish_ecb}, {group, no_blowfish_ofb64}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, no_aes_cfb128}, + {group, no_aes_cfb8}, + {group, no_aes_ige256}, {group, no_des_cbc}, {group, no_des_cfb}, - {group, des_ede3}, - {group, no_poly1305}, {group, no_rc2_cbc}, - {group, no_rc4} + {group, no_rc4}, + + ?NEW_CIPHER_TYPE_SCHEMA, + ?RETIRED_TYPE_ALIASES ]}, - {md4, [], [hash]}, - {md5, [], [hash, hmac]}, - {ripemd160, [], [hash]}, - {sha, [], [hash, hmac]}, - {sha224, [], [hash, hmac]}, - {sha256, [], [hash, hmac]}, - {sha384, [], [hash, hmac]}, - {sha512, [], [hash, hmac]}, - {sha3_224, [], [hash, hmac]}, - {sha3_256, [], [hash, hmac]}, - {sha3_384, [], [hash, hmac]}, - {sha3_512, [], [hash, hmac]}, - {blake2b, [], [hash, hmac]}, - {blake2s, [], [hash, hmac]}, - {no_blake2b, [], [no_hash, no_hmac]}, - {no_blake2s, [], [no_hash, no_hmac]}, - {rsa, [], [sign_verify, - public_encrypt, - private_encrypt, - generate - ]}, - {dss, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ecdsa, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ed25519, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ed448, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {dh, [], [generate_compute, - compute_bug]}, - {ecdh, [], [use_all_elliptic_curves, compute, generate]}, - {srp, [], [generate_compute]}, - {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des_ede3,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cbf,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cfb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {rc2_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cbc128,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, - {aes_cfb8,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cfb128,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cbc256,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, - {aes_ecb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ige256,[], [block]}, - {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_ecb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_ofb64,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ctr, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ccm, [], [aead]}, - {aes_gcm, [], [aead]}, - {chacha20_poly1305, [], [aead]}, - {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {poly1305, [], [poly1305]}, - {no_poly1305, [], [no_poly1305]}, - {aes_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {no_aes_cfb8,[], [no_support, no_block]}, - {no_aes_cfb128,[], [no_support, no_block]}, - {no_md4, [], [no_support, no_hash]}, - {no_md5, [], [no_support, no_hash, no_hmac]}, - {no_ed25519, [], [no_support, no_sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {no_ed448, [], [no_support, no_sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {no_ripemd160, [], [no_support, no_hash]}, - {no_srp, [], [no_support, no_generate_compute]}, - {no_des_cbc, [], [no_support, no_block]}, - {no_des_cfb, [], [no_support, no_block]}, - {no_blowfish_cbc, [], [no_support, no_block]}, - {no_blowfish_ecb, [], [no_support, no_block]}, - {no_blowfish_cfb64, [], [no_support, no_block]}, - {no_blowfish_ofb64, [], [no_support, no_block]}, - {no_aes_ige256, [], [no_support, no_block]}, + + {md4, [], [hash]}, + {md5, [], [hash, hmac]}, + {ripemd160, [], [hash]}, + {sha, [], [hash, hmac]}, + {sha224, [], [hash, hmac]}, + {sha256, [], [hash, hmac]}, + {sha384, [], [hash, hmac]}, + {sha512, [], [hash, hmac]}, + {sha3_224, [], [hash, hmac]}, + {sha3_256, [], [hash, hmac]}, + {sha3_384, [], [hash, hmac]}, + {sha3_512, [], [hash, hmac]}, + {blake2b, [], [hash, hmac]}, + {blake2s, [], [hash, hmac]}, + {no_blake2b, [], [no_hash, no_hmac]}, + {no_blake2s, [], [no_hash, no_hmac]}, + {rsa, [], [sign_verify, + public_encrypt, + private_encrypt, + generate + ]}, + {dss, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ecdsa, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ed25519, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ed448, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {dh, [], [generate_compute, compute_bug]}, + {ecdh, [], [use_all_elliptic_curves, compute, generate]}, + {srp, [], [generate_compute]}, + {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {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]}, + {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]}, + {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]}, + {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ecb, [], [block, api_ng, api_ng_one_shot]}, + {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ofb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_ctr, [], [stream]}, + {chacha20_poly1305, [], [aead]}, + {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {poly1305, [], [poly1305]}, + {no_poly1305, [], [no_poly1305]}, + {no_aes_cfb128, [], [no_support, no_block]}, + {no_md4, [], [no_support, no_hash]}, + {no_md5, [], [no_support, no_hash, no_hmac]}, + {no_ed25519, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {no_ed448, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {no_ripemd160, [], [no_support, no_hash]}, + {no_srp, [], [no_support, no_generate_compute]}, + {no_des_cbc, [], [no_support, no_block]}, + {no_des_cfb, [], [no_support, no_block]}, + {no_blowfish_cbc, [], [no_support, no_block]}, + {no_blowfish_ecb, [], [no_support, no_block]}, + {no_blowfish_cfb64, [], [no_support, no_block]}, + {no_blowfish_ofb64, [], [no_support, no_block]}, + {no_aes_ige256, [], [no_support, no_block]}, {no_chacha20_poly1305, [], [no_support, no_aead]}, - {no_chacha20, [], [no_support, no_stream_ivec]}, - {no_rc2_cbc, [], [no_support, no_block]}, - {no_rc4, [], [no_support, no_stream]}, - {api_errors, [], [api_errors_ecdh]} + {no_chacha20, [], [no_support, no_stream_ivec]}, + {no_rc2_cbc, [], [no_support, no_block]}, + {no_rc4, [], [no_support, no_stream]}, + {api_errors, [], [api_errors_ecdh]}, + + %% New cipher nameing schema + {des_ede3_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3_cfb, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_ccm, [], [aead]}, + {aes_192_ccm, [], [aead]}, + {aes_256_ccm, [], [aead]}, + {aes_128_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_192_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_256_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_128_gcm, [], [aead]}, + {aes_192_gcm, [], [aead]}, + {aes_256_gcm, [], [aead]}, + + %% Retired aliases + {aes_cbc, [], [block]}, + {aes_cbc128, [], [block]}, + {aes_cbc256, [], [block]}, + {aes_ccm, [], [aead]}, + {aes_ecb, [], [block]}, + {aes_gcm, [], [aead]}, + {des3_cbc, [], [block]}, + {des_ede3, [], [block]}, + {des3_cbf, [], [block]}, + {des3_cfb, [], [block]} ]. %%------------------------------------------------------------------- @@ -429,8 +490,7 @@ poly1305(Config) -> %%-------------------------------------------------------------------- no_poly1305() -> [{doc, "Test disabled poly1305 function"}]. -no_poly1305(Config) -> - Type = ?config(type, 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">>, @@ -440,7 +500,7 @@ no_poly1305(Config) -> block() -> [{doc, "Test block ciphers"}]. block(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config)), + [_|_] = Blocks = lazy_eval(proplists:get_value(cipher, Config)), lists:foreach(fun block_cipher/1, Blocks), lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), lists:foreach(fun block_cipher_increment/1, block_iolistify(Blocks)). @@ -449,7 +509,7 @@ block(Config) when is_list(Config) -> no_block() -> [{doc, "Test disabled block ciphers"}]. no_block(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config)), + [_|_] = Blocks = lazy_eval(proplists:get_value(cipher, Config)), Args = case Blocks of [{_Type, _Key, _PlainText} = A | _] -> tuple_to_list(A); @@ -466,10 +526,8 @@ api_ng() -> [{doc, "Test new api"}]. api_ng(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun api_ng_cipher_increment/1, Blocks++Streams). - + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun api_ng_cipher_increment/1, Ciphers). api_ng_cipher_increment({Type, Key, PlainTexts}=_X) -> ct:log("~p",[_X]), @@ -523,9 +581,8 @@ api_ng_one_shot() -> [{doc, "Test new api"}]. api_ng_one_shot(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun do_api_ng_one_shot/1, Blocks++Streams). + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun do_api_ng_one_shot/1, Ciphers). do_api_ng_one_shot({Type, Key, PlainTexts}=_X) -> ct:log("~p",[_X]), @@ -537,8 +594,8 @@ do_api_ng_one_shot({Type, Key, IV, PlainTexts}=_X) -> do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("~p",[_X]), - PlainText = iolist_to_binary(PlainText0), - EncTxt = crypto:crypto_one_shot(Type, Key, IV, PlainText, true), + PlainText = iolist_to_binary(lazy_eval(PlainText0)), + EncTxt = crypto:crypto_one_time(Type, Key, IV, PlainText, true), case ExpectedEncText of undefined -> ok; @@ -546,14 +603,14 @@ do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ok; _ -> ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, EncTxt]), - ct:fail("api_ng_one_shot (encode)",[]) + ct:fail("api_ng_one_time (encode)",[]) end, - case crypto:crypto_one_shot(Type, Key, IV, EncTxt, false) of + case crypto:crypto_one_time(Type, Key, IV, EncTxt, false) of PlainText -> ok; OtherPT -> ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), - ct:fail("api_ng_one_shot (decode)",[]) + ct:fail("api_ng_one_time (decode)",[]) end. %%-------------------------------------------------------------------- @@ -561,9 +618,8 @@ api_ng_tls() -> [{doc, "Test special tls api"}]. api_ng_tls(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun do_api_ng_tls/1, Blocks++Streams). + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun do_api_ng_tls/1, Ciphers). do_api_ng_tls({Type, Key, PlainTexts}=_X) -> @@ -576,16 +632,16 @@ do_api_ng_tls({Type, Key, IV, PlainTexts}=_X) -> do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("~p",[_X]), - PlainText = iolist_to_binary(PlainText0), - Renc = crypto:crypto_init_dyn_iv(Type, Key, true), - Rdec = crypto:crypto_init_dyn_iv(Type, Key, false), - EncTxt = crypto:crypto_update_dyn_iv(Renc, PlainText, IV), + PlainText = iolist_to_binary(lazy_eval(PlainText0)), + Renc = crypto:crypto_dyn_iv_init(Type, Key, true), + Rdec = crypto:crypto_dyn_iv_init(Type, Key, false), + EncTxt = crypto:crypto_dyn_iv_update(Renc, PlainText, IV), case ExpectedEncText of undefined -> ok; EncTxt -> %% Now check that the state is NOT updated: - case crypto:crypto_update_dyn_iv(Renc, PlainText, IV) of + case crypto:crypto_dyn_iv_update(Renc, PlainText, IV) of EncTxt -> ok; EncTxt2 -> @@ -596,10 +652,10 @@ do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("1st encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, OtherEnc]), ct:fail("api_ng_tls (encode)",[]) end, - case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + case crypto:crypto_dyn_iv_update(Rdec, EncTxt, IV) of PlainText -> %% Now check that the state is NOT updated: - case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + case crypto:crypto_dyn_iv_update(Rdec, EncTxt, IV) of PlainText -> ok; PlainText2 -> @@ -616,7 +672,7 @@ no_aead() -> [{doc, "Test disabled aead ciphers"}]. no_aead(Config) when is_list(Config) -> EncArg4 = - case lazy_eval(proplists:get_value(aead, Config)) of + case lazy_eval(proplists:get_value(cipher, Config)) of [{Type, Key, PlainText, Nonce, AAD, CipherText, CipherTag, TagLen, _Info} | _] -> {AAD, PlainText, TagLen}; [{Type, Key, PlainText, Nonce, AAD, CipherText, CipherTag, _Info} | _] -> @@ -631,7 +687,7 @@ no_aead(Config) when is_list(Config) -> stream() -> [{doc, "Test stream ciphers"}]. stream(Config) when is_list(Config) -> - Streams = lazy_eval(proplists:get_value(stream, Config)), + [_|_] = Streams = lazy_eval(proplists:get_value(cipher, Config)), lists:foreach(fun stream_cipher/1, Streams), lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)), @@ -654,8 +710,7 @@ no_stream_ivec(Config) when is_list(Config) -> aead() -> [{doc, "Test AEAD ciphers"}]. aead(Config) when is_list(Config) -> - AEADs = lazy_eval(proplists:get_value(aead, Config)), - + [_|_] = AEADs = lazy_eval(proplists:get_value(cipher, Config)), FilteredAEADs = case proplists:get_bool(fips, Config) of false -> @@ -668,7 +723,6 @@ aead(Config) when is_list(Config) -> IVLen >= 12 end, AEADs) end, - lists:foreach(fun aead_cipher/1, FilteredAEADs). %%-------------------------------------------------------------------- @@ -847,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() -> @@ -985,13 +1055,27 @@ block_cipher({Type, Key, IV, PlainText, CipherText}) -> ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other1}}) end. -block_cipher_increment({Type, Key, IV, PlainTexts}) - when Type == des_cbc; Type == aes_cbc; Type == des3_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc ; + Type == des3_cbc ; + Type == aes_128_cbc ; + Type == aes_192_cbc ; + Type == aes_256_cbc + -> block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); -block_cipher_increment({Type, Key, IV, PlainTexts, CipherText}) - when Type == des_cbc; Type == des3_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts, CipherText}) when Type == des_cbc; + Type == des_ede3_cbc ; + Type == des3_cbc ; + Type == des_ede3 ; + Type == des_ede3_cfb ; + Type == des_ede3_cbf ; + Type == des3_cbf ; + Type == des3_cfb + -> block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), CipherText, []); -block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_128_cbc ; + Type == aes_192_cbc ; + Type == aes_256_cbc + -> Plain = iolist_to_binary(PlainTexts), Blocks = [iolistify(Block) || << Block:128/bitstring >> <= Plain], block_cipher_increment(Type, Key, IV, IV, Blocks, Plain, []); @@ -1025,8 +1109,9 @@ block_cipher_increment(Type, Key, IV0, IV, [PlainText | PlainTexts], Plain, Ciph NextIV = crypto:next_iv(Type, CT), block_cipher_increment(Type, Key, IV0, NextIV, PlainTexts, Plain, CipherText, [CT | Acc]). -stream_cipher({Type, Key, PlainText}) -> - Plain = iolist_to_binary(PlainText), +stream_cipher({Type, Key, PlainText0}) -> + PlainText = lazy_eval(PlainText0), + Plain = iolist_to_binary(lazy_eval(PlainText)), StateE = crypto:stream_init(Type, Key), StateD = crypto:stream_init(Type, Key), {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), @@ -1036,7 +1121,8 @@ stream_cipher({Type, Key, PlainText}) -> Other -> ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; -stream_cipher({Type, Key, IV, PlainText}) -> +stream_cipher({Type, Key, IV, PlainText0}) -> + PlainText = lazy_eval(PlainText0), Plain = iolist_to_binary(PlainText), StateE = crypto:stream_init(Type, Key, IV), StateD = crypto:stream_init(Type, Key, IV), @@ -1047,7 +1133,8 @@ stream_cipher({Type, Key, IV, PlainText}) -> Other -> ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; -stream_cipher({Type, Key, IV, PlainText, CipherText}) -> +stream_cipher({Type, Key, IV, PlainText0, CipherText}) -> + PlainText = lazy_eval(PlainText0), Plain = iolist_to_binary(PlainText), StateE = crypto:stream_init(Type, Key, IV), StateD = crypto:stream_init(Type, Key, IV), @@ -1112,7 +1199,7 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, Info}) -> aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info}) -> <<TruncatedCipherTag:TagLen/binary, _/binary>> = CipherTag, Plain = iolist_to_binary(PlainText), - case crypto:block_encrypt(Type, Key, IV, {AAD, Plain, TagLen}) of + try crypto:block_encrypt(Type, Key, IV, {AAD, Plain, TagLen}) of {CipherText, TruncatedCipherTag} -> ok; Other0 -> @@ -1121,6 +1208,18 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info} [{info,Info}, {key,Key}, {pt,PlainText}, {iv,IV}, {aad,AAD}, {ct,CipherText}, {tag,CipherTag}, {taglen,TagLen}]}, {expected, {CipherText, TruncatedCipherTag}}, {got, Other0}}) + catch + error:E -> + ct:log("~p",[{Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info}]), + try crypto:crypto_one_time_aead(Type, Key, IV, PlainText, AAD, TagLen, true) + of + RR -> + ct:log("Works: ~p",[RR]) + catch + CC:EE -> + ct:log("~p:~p", [CC,EE]) + end, + ct:fail("~p",[E]) end, case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, TruncatedCipherTag}) of Plain -> @@ -1369,16 +1468,15 @@ do_stream_iolistify({Type, Key, IV, PlainText}) -> {Type, iolistify(Key), IV, iolistify(PlainText)}; do_stream_iolistify({Type, Key, IV, PlainText, CipherText}) -> {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. - -do_block_iolistify({des_cbc = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cbc = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cbf = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cfb = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) -> +do_block_iolistify({Type, Key, IV, PlainText}) when Type == des_cbc ; + Type == des_ede3_cbc ; + Type == des3_cbc ; + Type == des_ede3 ; + Type == des_ede3_cfb ; + Type == des_ede3_cbf ; + Type == des3_cbf ; + Type == des3_cfb + -> {Type, Key, IV, des_iolistify(PlainText)}; do_block_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; @@ -1387,10 +1485,13 @@ do_block_iolistify({Type, Key, IV, PlainText}) -> do_block_iolistify({Type, Key, IV, PlainText, CipherText}) -> {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. -iolistify(<<"Test With Truncation">>)-> +iolistify(X) -> + iolistify1(lazy_eval(X)). + +iolistify1(<<"Test With Truncation">>)-> %% Do not iolistify as it spoils this special case <<"Test With Truncation">>; -iolistify(Msg) when is_binary(Msg) -> +iolistify1(Msg) when is_binary(Msg) -> Length = erlang:byte_size(Msg), Split = Length div 2, List0 = binary_to_list(Msg), @@ -1400,8 +1501,8 @@ iolistify(Msg) when is_binary(Msg) -> {List1, List2}-> [List1, List2] end; -iolistify(Msg) -> - iolistify(list_to_binary(Msg)). +iolistify1(Msg) when is_list(Msg) -> + iolistify1(list_to_binary(Msg)). des_iolistify(Msg) -> des_iolist(erlang:byte_size(Msg) div 8, Msg, []). @@ -1480,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; @@ -1710,7 +1811,6 @@ group_config(dss = Type, Config) -> MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{dss, Public, Private, MsgPubEnc, []}], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; - group_config(ecdsa = Type, Config) -> {Private, Public} = ec_key_named(), Msg = ec_msg(), @@ -1722,15 +1822,13 @@ group_config(ecdsa = Type, Config) -> MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{ecdsa, Public, Private, MsgPubEnc, []}], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; - group_config(Type, Config) when Type == ed25519 ; Type == ed448 -> TestVectors = eddsa(Type), [{sign_verify,TestVectors} | Config]; - - group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; + group_config(ecdh, Config) -> Compute = ecdh(), Generate = ecc(), @@ -1738,77 +1836,19 @@ group_config(ecdh, Config) -> group_config(dh, Config) -> GenerateCompute = [dh()], [{generate_compute, GenerateCompute} | Config]; -group_config(des_cbc, Config) -> - Block = des_cbc(), - [{block, Block} | Config]; -group_config(des_cfb, Config) -> - Block = des_cfb(), - [{block, Block} | Config]; -group_config(des3_cbc, Config) -> - Block = des3_cbc(), - [{block, Block} | Config]; -group_config(des3_cbf, Config) -> - Block = des3_cbf(), - [{block, Block} | Config]; -group_config(des3_cfb, Config) -> - Block = des3_cfb(), - [{block, Block} | Config]; -group_config(des_ede3, Config) -> - Block = des_ede3(), - [{block, Block} | Config]; -group_config(rc2_cbc, Config) -> - Block = rc2_cbc(), - [{block, Block} | Config]; + group_config(aes_cbc128 = Type, Config) -> Block = fun() -> aes_cbc128(Config) end, Pairs = fun() -> cmac_nist(Config, Type) end, - [{block, Block}, {cmac, Pairs} | Config]; + [{cipher, Block}, {cmac, Pairs} | Config]; group_config(aes_cbc256 = Type, Config) -> Block = fun() -> aes_cbc256(Config) end, Pairs = fun() -> cmac_nist(Config, Type) end, - [{block, Block}, {cmac, Pairs} | Config]; -group_config(aes_ecb, Config) -> - Block = fun() -> aes_ecb(Config) end, - [{block, Block} | Config]; -group_config(aes_ige256, Config) -> - Block = aes_ige256(), - [{block, Block} | Config]; -group_config(aes_cfb8, Config) -> - Block = fun() -> aes_cfb8(Config) end, - [{block, Block} | Config]; -group_config(aes_cfb128, Config) -> - Block = fun() -> aes_cfb128(Config) end, - [{block, Block} | Config]; -group_config(blowfish_cbc, Config) -> - Block = blowfish_cbc(), - [{block, Block} | Config]; -group_config(blowfish_ecb, Config) -> - Block = blowfish_ecb(), - [{block, Block} | Config]; -group_config(blowfish_cfb64, Config) -> - Block = blowfish_cfb64(), - [{block, Block} | Config]; -group_config(blowfish_ofb64, Config) -> - Block = blowfish_ofb64(), - [{block, Block} | Config]; -group_config(rc4, Config) -> - Stream = rc4(), - [{stream, Stream} | Config]; -group_config(aes_ctr, Config) -> - Stream = aes_ctr(), - [{stream, Stream} | Config]; -group_config(aes_ccm, Config) -> - AEAD = fun() -> aes_ccm(Config) end, - [{aead, AEAD} | Config]; -group_config(aes_gcm, Config) -> - AEAD = fun() -> aes_gcm(Config) end, - [{aead, AEAD} | Config]; + [{cipher, Block}, {cmac, Pairs} | Config]; group_config(chacha20_poly1305, Config) -> - AEAD = chacha20_poly1305(), - [{aead, AEAD} | Config]; -group_config(chacha20, Config) -> - Stream = chacha20(), - [{stream, Stream} | Config]; + AEAD = chacha20_poly1305(Config), + [{cipher, AEAD} | Config]; + group_config(poly1305, Config) -> V = [%% {Key, Txt, Expect} {%% RFC7539 2.5.2 @@ -1818,11 +1858,12 @@ group_config(poly1305, Config) -> } ], [{poly1305,V} | Config]; -group_config(aes_cbc, Config) -> - Block = aes_cbc(Config), - [{block, Block} | Config]; -group_config(_, Config) -> - Config. + +group_config(F, Config) -> + TestVectors = fun() -> ?MODULE:F(Config) end, + [{cipher, TestVectors} | Config]. + + rsa_sign_verify_tests(Config, Msg, Public, Private, PublicS, PrivateS, OptsToTry) -> case ?config(fips, Config) of @@ -2413,19 +2454,19 @@ rfc4231_hmac_sha512() -> "debd71f8867289865df5a32d20cdc944" "b6022cac3c4982b10d5eeb55c3e4de15" "134676fb6de0446065c97440fa8c6a58")]. -des_cbc() -> +des_cbc(_) -> [{des_cbc, hexstr2bin("0123456789abcdef"), hexstr2bin("1234567890abcdef"), <<"Now is the time for all ">> }]. -des_cfb() -> +des_cfb(_) -> [{des_cfb, hexstr2bin("0123456789abcdef"), hexstr2bin("1234567890abcdef"), <<"Now is the">>}]. -des3_cbc() -> +des3_cbc(_) -> [{des3_cbc, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2434,7 +2475,7 @@ des3_cbc() -> <<"Now is the time for all ">> }]. -des_ede3() -> +des_ede3(_) -> [{des_ede3, [hexstr2bin("8000000000000000"), hexstr2bin("4000000000000000"), @@ -2443,7 +2484,23 @@ des_ede3() -> hexstr2bin("0000000000000000") }]. -des3_cbf() -> +des_ede3_cbc(_) -> + [{des_ede3_cbc, + [hexstr2bin("0123456789abcdef"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> + }, + {des_ede3_cbc, + [hexstr2bin("8000000000000000"), + hexstr2bin("4000000000000000"), + hexstr2bin("2000000000000000")], + hexstr2bin("7AD16FFB79C45926"), + hexstr2bin("0000000000000000") + }]. + +des3_cbf(_) -> [{des3_cbf, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2452,7 +2509,7 @@ des3_cbf() -> <<"Now is the time for all ">> }]. -des3_cfb() -> +des3_cfb(_) -> [{des3_cfb, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2461,7 +2518,16 @@ des3_cfb() -> <<"Now is the time for all ">> }]. -rc2_cbc() -> +des_ede3_cfb(_) -> + [{des_ede3_cfb, + [hexstr2bin("0123456789abcdef"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> + }]. + +rc2_cbc(_) -> [{rc2_cbc, <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, <<72,91,135,182,25,42,35,210>>, @@ -2470,7 +2536,8 @@ rc2_cbc() -> %% AES CBC test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf aes_cbc(Config) -> - read_rsp(Config, aes_cbc, + %% RETIRED aes_*_cbc + read_rsp(Config, aes_cbc, ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", "CBCVarTxt192.rsp", "CBCVarKey192.rsp", "CBCGFSbox192.rsp", "CBCKeySbox192.rsp", "CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", @@ -2478,15 +2545,32 @@ aes_cbc(Config) -> ]). aes_cbc128(Config) -> + %% RETIRED aes_128_cbc read_rsp(Config, aes_cbc128, ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", "CBCMMT128.rsp"]). aes_cbc256(Config) -> + %% RETIRED aes_256_cbc read_rsp(Config, aes_cbc256, ["CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", "CBCMMT256.rsp"]). +aes_128_cbc(Config) -> + read_rsp(Config, aes_128_cbc, + ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", + "CBCMMT128.rsp"]). + +aes_192_cbc(Config) -> + read_rsp(Config, aes_192_cbc, + ["CBCVarTxt192.rsp", "CBCVarKey192.rsp", "CBCGFSbox192.rsp", "CBCKeySbox192.rsp", + "CBCMMT192.rsp"]). + +aes_256_cbc(Config) -> + read_rsp(Config, aes_256_cbc, + ["CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", + "CBCMMT256.rsp"]). + aes_ecb(Config) -> read_rsp(Config, aes_ecb, ["ECBVarTxt128.rsp", "ECBVarKey128.rsp", "ECBGFSbox128.rsp", "ECBKeySbox128.rsp", @@ -2494,7 +2578,22 @@ aes_ecb(Config) -> "ECBVarTxt256.rsp", "ECBVarKey256.rsp", "ECBGFSbox256.rsp", "ECBKeySbox256.rsp", "ECBMMT128.rsp", "ECBMMT192.rsp", "ECBMMT256.rsp"]). -aes_ige256() -> +aes_128_ecb(Config) -> + read_rsp(Config, aes_128_ecb, + ["ECBVarTxt128.rsp", "ECBVarKey128.rsp", "ECBGFSbox128.rsp", "ECBKeySbox128.rsp", + "ECBMMT128.rsp"]). + +aes_192_ecb(Config) -> + read_rsp(Config, aes_192_ecb, + ["ECBVarTxt192.rsp", "ECBVarKey192.rsp", "ECBGFSbox192.rsp", "ECBKeySbox192.rsp", + "ECBMMT192.rsp"]). + +aes_256_ecb(Config) -> + read_rsp(Config, aes_256_ecb, + ["ECBVarTxt256.rsp", "ECBVarKey256.rsp", "ECBGFSbox256.rsp", "ECBKeySbox256.rsp", + "ECBMMT256.rsp"]). + +aes_ige256(_) -> [{aes_ige256, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), hexstr2bin("000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F"), @@ -2520,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", @@ -2527,14 +2642,30 @@ aes_cfb128(Config) -> "CFB128VarTxt256.rsp", "CFB128VarKey256.rsp", "CFB128GFSbox256.rsp", "CFB128KeySbox256.rsp", "CFB128MMT128.rsp", "CFB128MMT192.rsp", "CFB128MMT256.rsp"]). -blowfish_cbc() -> +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"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000000000") }]. -blowfish_ecb() -> +blowfish_ecb(_) -> [ {blowfish_ecb, hexstr2bin("0000000000000000"), @@ -2631,26 +2762,26 @@ blowfish_ecb() -> hexstr2bin("FFFFFFFFFFFFFFFF")} ]. -blowfish_cfb64() -> +blowfish_cfb64(_) -> [{blowfish_cfb64, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") }]. -blowfish_ofb64() -> +blowfish_ofb64(_) -> [{blowfish_ofb64, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") }]. -rc4() -> +rc4(_) -> [{rc4, <<"apaapa">>, <<"Yo baby yo">>}, {rc4, <<"apaapa">>, list_to_binary(lists:seq(0, 255))}, {rc4, <<"apaapa">>, long_msg()} ]. -aes_ctr() -> +aes_ctr(_) -> [ %% F.5.3 CTR-AES192.Encrypt {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), @@ -2699,24 +2830,109 @@ aes_ctr() -> ]. +aes_128_ctr(_) -> + [ %% F.5.3 CTR-AES192.Encrypt + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef") }, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_192_ctr(_) -> + [ %% F.5.3 CTR-AES192.Encrypt + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_256_ctr(_) -> + [ %% F.5.5 CTR-AES256.Encrypt + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + long_msg()} + ]. + + aes_gcm(Config) -> - read_rsp(Config, aes_gcm, + %% RETIRED aes_*_gcm + read_rsp(Config, aes_gcm, + ["gcmDecrypt128.rsp", + "gcmDecrypt192.rsp", + "gcmDecrypt256.rsp", + "gcmEncryptExtIV128.rsp", + "gcmEncryptExtIV192.rsp", + "gcmEncryptExtIV256.rsp"]). + +aes_128_gcm(Config) -> + read_rsp(Config, aes_128_gcm, ["gcmDecrypt128.rsp", - "gcmDecrypt192.rsp", - "gcmDecrypt256.rsp", - "gcmEncryptExtIV128.rsp", - "gcmEncryptExtIV192.rsp", + "gcmEncryptExtIV128.rsp"]). + +aes_192_gcm(Config) -> + read_rsp(Config, aes_192_gcm, + ["gcmDecrypt192.rsp", + "gcmEncryptExtIV192.rsp"]). + +aes_256_gcm(Config) -> + read_rsp(Config, aes_256_gcm, + ["gcmDecrypt256.rsp", "gcmEncryptExtIV256.rsp"]). + aes_ccm(Config) -> - read_rsp(Config, aes_ccm, - ["VADT128.rsp", "VADT192.rsp", "VADT256.rsp", - "VNT128.rsp", "VNT192.rsp", "VNT256.rsp", - "VPT128.rsp", "VPT192.rsp", "VPT256.rsp" - ]). + %% RETIRED aes_*_ccm + read_rsp(Config, aes_ccm, + ["VADT128.rsp", "VADT192.rsp", "VADT256.rsp", + "VNT128.rsp", "VNT192.rsp", "VNT256.rsp", + "VPT128.rsp", "VPT192.rsp", "VPT256.rsp" + ]). + +aes_128_ccm(Config) -> + read_rsp(Config, aes_128_ccm, + ["VADT128.rsp", "VNT128.rsp", "VPT128.rsp"]). + +aes_192_ccm(Config) -> + read_rsp(Config, aes_192_ccm, + ["VADT192.rsp", "VNT192.rsp", "VPT192.rsp"]). + +aes_256_ccm(Config) -> + read_rsp(Config, aes_256_ccm, + ["VADT256.rsp", "VNT256.rsp", "VPT256.rsp"]). + + %% https://tools.ietf.org/html/rfc7539#appendix-A.5 -chacha20_poly1305() -> +chacha20_poly1305(_) -> [ {chacha20_poly1305, hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" %% Key @@ -2763,7 +2979,7 @@ chacha20_poly1305() -> ]. -chacha20() -> +chacha20(_) -> %%% chacha20 (no mode) test vectors from RFC 7539 A.2 [ %% Test Vector #1: @@ -3697,9 +3913,18 @@ parse_rsp(_Type, [], _State, Acc) -> Acc; parse_rsp(_Type, [<<"DECRYPT">>|_], _State, Acc) -> Acc; +parse_rsp(_Type, [<<"ENCRYPT">>|_], _State, Acc) -> + Acc; %% AES format parse_rsp(Type, [<<"COUNT = ", _/binary>>, <<"KEY = ", Key/binary>>, + <<"PLAINTEXT = ", PlainText/binary>>, + <<"CIPHERTEXT = ", CipherText/binary>>|Next], State, Acc) -> + parse_rsp(Type, Next, State, + [{Type, hexstr2bin(Key), + hexstr2bin(PlainText), hexstr2bin(CipherText)}|Acc]); +parse_rsp(Type, [<<"COUNT = ", _/binary>>, + <<"KEY = ", Key/binary>>, <<"IV = ", IV/binary>>, <<"PLAINTEXT = ", PlainText/binary>>, <<"CIPHERTEXT = ", CipherText/binary>>|Next], State, Acc) -> diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl index 3416fbd78d..41cd132734 100644 --- a/lib/crypto/test/engine_SUITE.erl +++ b/lib/crypto/test/engine_SUITE.erl @@ -148,8 +148,21 @@ end_per_group(_, Config) -> end. %%-------------------------------------------------------------------- -init_per_testcase(_Case, Config) -> - Config. +init_per_testcase(Case, Config) -> + case string:tokens(atom_to_list(Case),"_") of + ["sign","verify",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + ["priv","encrypt","pub","decrypt",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + ["get","pub","from","priv","key",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + _ -> + Config + end. + end_per_testcase(_Case, _Config) -> ok. @@ -851,6 +864,19 @@ get_pub_from_priv_key_ecdsa(Config) -> %%%================================================================ %%% Help for engine_stored_pub_priv_keys* test cases %%% +skip_if_unsup(Type, Config) -> + case pkey_supported(Type) of + false -> + {skip, "Unsupported in this cryptolib"}; + true -> + Config + end. + + +pkey_supported(Type) -> + lists:member(Type, proplists:get_value(public_keys, crypto:supports(), [])). + + load_storage_engine(Config) -> load_storage_engine(Config, []). 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/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index f5e8337eb1..443de7b0dd 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2017</year> + <year>2006</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -85,7 +85,7 @@ dialyzer --help</code> dialyzer [--add_to_plt] [--apps applications] [--build_plt] [--check_plt] [-Ddefine]* [-Dname] [--dump_callgraph file] [files_or_dirs] [--fullpath] [--get_warnings] [--gui] [--help] - [-I include_dir]* [--no_check_plt] [--no_native] + [-I include_dir]* [--no_check_plt] [--no_indentation] [--no_native] [--no_native_cache] [-o outfile] [--output_plt file] [-pa dir]* [--plt plt] [--plt_info] [--plts plt*] [--quiet] [-r dirs] [--raw] [--remove_from_plt] [--shell] [--src] [--statistics] @@ -181,6 +181,11 @@ dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam</code> <p>Skip the PLT check when running Dialyzer. This is useful when working with installed PLTs that never change.</p> </item> + <tag><c>--no_indentation</c></tag> + <item> + <p>Do not insert line breaks in types, contracts, and Erlang + Code when formatting warnings.</p> + </item> <tag><c>--no_native</c> (or <c>-nn</c>)</tag> <item> <p>Bypass the native code compilation of some key files that @@ -485,6 +490,23 @@ dialyzer --plts plt_1 ... plt_n -- files_to_analyze</code> </func> <func> + <name since="">format_warning(Msg, Options) -> string()</name> + <fsummary>Get the string version of a warning message.</fsummary> + <type> + <v>Msg = {Tag, Id, msg()}</v> + <d>See <c>run/1</c>.</d> + <v>Options = [{indent_opt, boolean()}]</v> + </type> + <desc> + <p>Get a string from warnings as returned by + <seealso marker="#run/1"><c>run/1</c></seealso>.</p> + <p>If <c>indent_opt</c> is set to <c>true</c> (default), + line breaks are inserted in types, contracts, and Erlang + code to improve readability.</p> + </desc> + </func> + + <func> <name since="">gui() -> ok | {error, Msg}</name> <name since="">gui(OptList) -> ok | {error, Msg}</name> <fsummary>Dialyzer GUI version.</fsummary> diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 185c8c9ae6..cfe5fa9b3f 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -280,20 +280,23 @@ cl_check_log(Output) -> format_warning(W) -> format_warning(W, basename). --spec format_warning(raw_warning() | dial_warning(), fopt()) -> string(). - -format_warning({Tag, {File, Line, _MFA}, Msg}, FOpt) -> - format_warning({Tag, {File, Line}, Msg}, FOpt); -format_warning({_Tag, {File, Line}, Msg}, FOpt) when is_list(File), +-spec format_warning(raw_warning() | dial_warning(), + fopt() | proplists:proplist()) -> string(). + +format_warning(RawWarning, FOpt) when is_atom(FOpt) -> + format_warning(RawWarning, [{filename_opt, FOpt}]); +format_warning({Tag, {File, Line, _MFA}, Msg}, Opts) -> + format_warning({Tag, {File, Line}, Msg}, Opts); +format_warning({_Tag, {File, Line}, Msg}, Opts) when is_list(File), is_integer(Line) -> - F = case FOpt of + F = case proplists:get_value(filename_opt, Opts, basename) of fullpath -> File; basename -> filename:basename(File) end, - String = lists:flatten(message_to_string(Msg)), + Indent = proplists:get_value(indent_opt, Opts, ?INDENT_OPT), + String = message_to_string(Msg, Indent), lists:flatten(io_lib:format("~ts:~w: ~ts", [F, Line, String])). - %%----------------------------------------------------------------------------- %% Message classification and pretty-printing below. Messages appear in %% categories and in more or less alphabetical ordering within each category. @@ -301,52 +304,60 @@ format_warning({_Tag, {File, Line}, Msg}, FOpt) when is_list(File), %%----- Warnings for general discrepancies ---------------- message_to_string({apply, [Args, ArgNs, FailReason, - SigArgs, SigRet, Contract]}) -> - io_lib:format("Fun application with arguments ~ts ", [Args]) ++ - call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract); -message_to_string({app_call, [M, F, Args, Culprit, ExpectedType, FoundType]}) -> + SigArgs, SigRet, Contract]}, I) -> + io_lib:format("Fun application with arguments ~ts ", [a(Args, I)]) ++ + call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract, I); +message_to_string({app_call, [M, F, Args, Culprit, ExpectedType, FoundType]}, + I) -> io_lib:format("The call ~s:~ts~ts requires that ~ts is of type ~ts not ~ts\n", - [M, F, Args, Culprit, ExpectedType, FoundType]); -message_to_string({bin_construction, [Culprit, Size, Seg, Type]}) -> + [M, F, a(Args, I), c(Culprit, I), + t(ExpectedType, I), t(FoundType, I)]); +message_to_string({bin_construction, [Culprit, Size, Seg, Type]}, I) -> io_lib:format("Binary construction will fail since the ~s field ~s in" - " segment ~s has type ~s\n", [Culprit, Size, Seg, Type]); + " segment ~s has type ~s\n", + [Culprit, c(Size, I), c(Seg, I), t(Type, I)]); message_to_string({call, [M, F, Args, ArgNs, FailReason, - SigArgs, SigRet, Contract]}) -> - io_lib:format("The call ~w:~tw~ts ", [M, F, Args]) ++ - call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract); -message_to_string({call_to_missing, [M, F, A]}) -> + SigArgs, SigRet, Contract]}, I) -> + io_lib:format("The call ~w:~tw~ts ", [M, F, a(Args, I)]) ++ + call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract, I); +message_to_string({call_to_missing, [M, F, A]}, _I) -> io_lib:format("Call to missing or unexported function ~w:~tw/~w\n", [M, F, A]); -message_to_string({exact_eq, [Type1, Op, Type2]}) -> +message_to_string({exact_eq, [Type1, Op, Type2]}, I) -> io_lib:format("The test ~ts ~s ~ts can never evaluate to 'true'\n", - [Type1, Op, Type2]); -message_to_string({fun_app_args, [Args, Type]}) -> + [t(Type1, I), Op, t(Type2, I)]); +message_to_string({fun_app_args, [ArgNs, Args, Type]}, I) -> + PositionString = form_position_string(ArgNs), io_lib:format("Fun application with arguments ~ts will fail" - " since the function has type ~ts\n", [Args, Type]); -message_to_string({fun_app_no_fun, [Op, Type, Arity]}) -> + " since the function has type ~ts," + " which differs in the ~s argument\n", + [a(Args, I), t(Type, I), PositionString]); +message_to_string({fun_app_no_fun, [Op, Type, Arity]}, I) -> io_lib:format("Fun application will fail since ~ts :: ~ts" - " is not a function of arity ~w\n", [Op, Type, Arity]); -message_to_string({guard_fail, []}) -> + " is not a function of arity ~w\n", [Op, t(Type, I), Arity]); +message_to_string({guard_fail, []}, _I) -> "Clause guard cannot succeed.\n"; -message_to_string({guard_fail, [Arg1, Infix, Arg2]}) -> - io_lib:format("Guard test ~ts ~s ~ts can never succeed\n", [Arg1, Infix, Arg2]); -message_to_string({map_update, [Type, Key]}) -> +message_to_string({guard_fail, [Arg1, Infix, Arg2]}, I) -> + io_lib:format("Guard test ~ts ~s ~ts can never succeed\n", + [a(Arg1, I), Infix, a(Arg2, I)]); % a/2 rather than c/2 +message_to_string({map_update, [Type, Key]}, I) -> io_lib:format("A key of type ~ts cannot exist " - "in a map of type ~ts\n", [Key, Type]); -message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}) -> + "in a map of type ~ts\n", [t(Key, I), t(Type, I)]); +message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}, I) -> io_lib:format("Guard test not(~ts ~s ~ts) can never succeed\n", - [Arg1, Infix, Arg2]); -message_to_string({guard_fail, [Guard, Args]}) -> - io_lib:format("Guard test ~w~ts can never succeed\n", [Guard, Args]); -message_to_string({neg_guard_fail, [Guard, Args]}) -> - io_lib:format("Guard test not(~w~ts) can never succeed\n", [Guard, Args]); -message_to_string({guard_fail_pat, [Pat, Type]}) -> + [a(Arg1, I), Infix, a(Arg2, I)]); % a/2 rather than c/2 +message_to_string({guard_fail, [Guard, Args]}, I) -> + io_lib:format("Guard test ~s~ts can never succeed\n", [Guard, a(Args, I)]); +message_to_string({neg_guard_fail, [Guard, Args]}, I) -> + io_lib:format("Guard test not(~s~ts) can never succeed\n", + [Guard, a(Args, I)]); +message_to_string({guard_fail_pat, [Pat, Type]}, I) -> io_lib:format("Clause guard cannot succeed. The ~ts was matched" - " against the type ~ts\n", [Pat, Type]); -message_to_string({improper_list_constr, [TlType]}) -> + " against the type ~ts\n", [ps(Pat, I), t(Type, I)]); +message_to_string({improper_list_constr, [TlType]}, I) -> io_lib:format("Cons will produce an improper list" - " since its 2nd argument is ~ts\n", [TlType]); -message_to_string({no_return, [Type|Name]}) -> + " since its 2nd argument is ~ts\n", [t(TlType, I)]); +message_to_string({no_return, [Type|Name]}, _I) -> NameString = case Name of [] -> "The created fun "; @@ -358,135 +369,150 @@ message_to_string({no_return, [Type|Name]}) -> only_normal -> NameString ++ "has no local return\n"; both -> NameString ++ "has no local return\n" end; -message_to_string({record_constr, [RecConstr, FieldDiffs]}) -> +message_to_string({record_constr, [RecConstr, FieldDiffs]}, I) -> io_lib:format("Record construction ~ts violates the" - " declared type of field ~ts\n", [RecConstr, FieldDiffs]); -message_to_string({record_constr, [Name, Field, Type]}) -> + " declared type of field ~ts\n", + [t(RecConstr, I), field_diffs(FieldDiffs, I)]); +message_to_string({record_constr, [Name, Field, Type]}, I) -> io_lib:format("Record construction violates the declared type for #~tw{}" - " since ~ts cannot be of type ~ts\n", [Name, Field, Type]); -message_to_string({record_matching, [String, Name]}) -> + " since ~ts cannot be of type ~ts\n", + [Name, ps(Field, I), t(Type, I)]); +message_to_string({record_matching, [String, Name]}, I) -> io_lib:format("The ~ts violates the" - " declared type for #~tw{}\n", [String, Name]); -message_to_string({record_match, [Pat, Type]}) -> + " declared type for #~tw{}\n", [rec_type(String, I), Name]); +message_to_string({record_match, [Pat, Type]}, I) -> io_lib:format("Matching of ~ts tagged with a record name violates" - " the declared type of ~ts\n", [Pat, Type]); -message_to_string({pattern_match, [Pat, Type]}) -> - io_lib:format("The ~ts can never match the type ~ts\n", [Pat, Type]); -message_to_string({pattern_match_cov, [Pat, Type]}) -> + " the declared type of ~ts\n", [ps(Pat, I), t(Type, I)]); +message_to_string({pattern_match, [Pat, Type]}, I) -> + io_lib:format("The ~ts can never match the type ~ts\n", + [ps(Pat, I), t(Type, I)]); +message_to_string({pattern_match_cov, [Pat, Type]}, I) -> io_lib:format("The ~ts can never match since previous" " clauses completely covered the type ~ts\n", - [Pat, Type]); -message_to_string({unmatched_return, [Type]}) -> + [ps(Pat, I), t(Type, I)]); +message_to_string({unmatched_return, [Type]}, I) -> io_lib:format("Expression produces a value of type ~ts," - " but this value is unmatched\n", [Type]); -message_to_string({unused_fun, [F, A]}) -> + " but this value is unmatched\n", [t(Type, I)]); +message_to_string({unused_fun, [F, A]}, _I) -> io_lib:format("Function ~tw/~w will never be called\n", [F, A]); %%----- Warnings for specs and contracts ------------------- -message_to_string({contract_diff, [M, F, _A, Contract, Sig]}) -> - io_lib:format("Type specification ~w:~tw~ts" - " is not equal to the success typing: ~w:~tw~ts\n", - [M, F, Contract, M, F, Sig]); -message_to_string({contract_subtype, [M, F, _A, Contract, Sig]}) -> - io_lib:format("Type specification ~w:~tw~ts" - " is a subtype of the success typing: ~w:~tw~ts\n", - [M, F, Contract, M, F, Sig]); -message_to_string({contract_supertype, [M, F, _A, Contract, Sig]}) -> - io_lib:format("Type specification ~w:~tw~ts" - " is a supertype of the success typing: ~w:~tw~ts\n", - [M, F, Contract, M, F, Sig]); -message_to_string({contract_range, [Contract, M, F, ArgStrings, Line, CRet]}) -> - io_lib:format("The contract ~w:~tw~ts cannot be right because the inferred" +message_to_string({contract_diff, [M, F, _A, Contract, Sig]}, I) -> + io_lib:format("Type specification ~ts" + " is not equal to the success typing: ~ts\n", + [con(M, F, Contract, I), con(M, F, Sig, I)]); +message_to_string({contract_subtype, [M, F, _A, Contract, Sig]}, I) -> + io_lib:format("Type specification ~ts" + " is a subtype of the success typing: ~ts\n", + [con(M, F, Contract, I), con(M, F, Sig, I)]); +message_to_string({contract_supertype, [M, F, _A, Contract, Sig]}, I) -> + io_lib:format("Type specification ~ts" + " is a supertype of the success typing: ~ts\n", + [con(M, F, Contract, I), con(M, F, Sig, I)]); +message_to_string({contract_range, [Contract, M, F, ArgStrings, Line, CRet]}, + I) -> + io_lib:format("The contract ~ts cannot be right because the inferred" " return for ~tw~ts on line ~w is ~ts\n", - [M, F, Contract, F, ArgStrings, Line, CRet]); -message_to_string({invalid_contract, [M, F, A, Sig]}) -> + [con(M, F, Contract, I), F, a(ArgStrings, I), Line, t(CRet, I)]); +message_to_string({invalid_contract, [M, F, A, Sig]}, I) -> io_lib:format("Invalid type specification for function ~w:~tw/~w." - " The success typing is ~ts\n", [M, F, A, Sig]); -message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]}) -> + " The success typing is ~ts\n", [M, F, A, sig(Sig, I)]); +message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]}, + I) -> io_lib:format("The specification for ~w:~tw/~w" " has an opaque subtype ~ts which is violated by the" - " success typing ~ts\n", [M, F, A, OpaqueType, SigType]); -message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}) -> + " success typing ~ts\n", + [M, F, A, t(OpaqueType, I), sig(SigType, I)]); +message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}, I) -> io_lib:format("The specification for ~w:~tw/~w states that the function" " might also return ~ts but the inferred return is ~ts\n", - [M, F, A, ExtraRanges, SigRange]); -message_to_string({missing_range, [M, F, A, ExtraRanges, ContrRange]}) -> + [M, F, A, t(ExtraRanges, I), t(SigRange, I)]); +message_to_string({missing_range, [M, F, A, ExtraRanges, ContrRange]}, I) -> io_lib:format("The success typing for ~w:~tw/~w implies that the function" " might also return ~ts but the specification return is ~ts\n", - [M, F, A, ExtraRanges, ContrRange]); -message_to_string({overlapping_contract, [M, F, A]}) -> + [M, F, A, t(ExtraRanges, I), t(ContrRange, I)]); +message_to_string({overlapping_contract, [M, F, A]}, _I) -> io_lib:format("Overloaded contract for ~w:~tw/~w has overlapping domains;" " such contracts are currently unsupported and are simply ignored\n", [M, F, A]); -message_to_string({spec_missing_fun, [M, F, A]}) -> +message_to_string({spec_missing_fun, [M, F, A]}, _I) -> io_lib:format("Contract for function that does not exist: ~w:~tw/~w\n", [M, F, A]); %%----- Warnings for opaque type violations ------------------- -message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}) -> +message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}, I) -> io_lib:format("The call ~w:~tw~ts contains ~ts when ~ts\n", - [M, F, Args, form_positions(ArgNs), form_expected(ExpArgs)]); -message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}) -> + [M, F, a(Args, I), form_positions(ArgNs), + form_expected(ExpArgs, I)]); +message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}, I) -> io_lib:format("The call ~w:~tw~ts does not have ~ts\n", - [M, F, Args, form_expected_without_opaque(ExpectedTriples)]); -message_to_string({opaque_eq, [Type, _Op, OpaqueType]}) -> + [M, F, a(Args, I), + form_expected_without_opaque(ExpectedTriples, I)]); +message_to_string({opaque_eq, [Type, _Op, OpaqueType]}, I) -> io_lib:format("Attempt to test for equality between a term of type ~ts" - " and a term of opaque type ~ts\n", [Type, OpaqueType]); -message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}) -> + " and a term of opaque type ~ts\n", + [t(Type, I), t(OpaqueType, I)]); +message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}, I) -> io_lib:format("Guard test ~ts ~s ~ts contains ~s\n", - [Arg1, Infix, Arg2, form_positions(ArgNs)]); -message_to_string({opaque_guard, [Guard, Args]}) -> + [a(Arg1, I), Infix, a(Arg2, I), form_positions(ArgNs)]); +message_to_string({opaque_guard, [Guard, Args]}, I) -> io_lib:format("Guard test ~w~ts breaks the opacity of its argument\n", - [Guard, Args]); -message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}) -> + [Guard, a(Args, I)]); +message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}, I) -> Term = if OpaqueType =:= OpaqueTerm -> "the term"; - true -> OpaqueTerm + true -> t(OpaqueTerm, I) end, - io_lib:format("The attempt to match a term of type ~s against the ~ts" - " breaks the opacity of ~ts\n", [OpaqueType, Pat, Term]); -message_to_string({opaque_neq, [Type, _Op, OpaqueType]}) -> + io_lib:format("The attempt to match a term of type ~ts against the ~ts" + " breaks the opacity of ~ts\n", + [t(OpaqueType, I), ps(Pat, I), Term]); +message_to_string({opaque_neq, [Type, _Op, OpaqueType]}, I) -> io_lib:format("Attempt to test for inequality between a term of type ~ts" - " and a term of opaque type ~ts\n", [Type, OpaqueType]); -message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}) -> + " and a term of opaque type ~ts\n", + [t(Type, I), t(OpaqueType, I)]); +message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}, I) -> io_lib:format("The type test ~ts~ts breaks the opacity of the term ~ts~ts\n", - [Fun, Args, Arg, ArgType]); -message_to_string({opaque_size, [SizeType, Size]}) -> + [Fun, a(Args, I), Arg, t(ArgType, I)]); +message_to_string({opaque_size, [SizeType, Size]}, I) -> io_lib:format("The size ~ts breaks the opacity of ~ts\n", - [SizeType, Size]); -message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) -> + [t(SizeType, I), c(Size, I)]); +message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}, I) -> io_lib:format("The call ~s:~ts~ts breaks the opacity of the term ~ts :: ~ts\n", - [M, F, Args, Culprit, OpaqueType]); + [M, F, a(Args, I), c(Culprit, I), t(OpaqueType, I)]); %%----- Warnings for concurrency errors -------------------- -message_to_string({race_condition, [M, F, Args, Reason]}) -> - io_lib:format("The call ~w:~tw~ts ~ts\n", [M, F, Args, Reason]); +message_to_string({race_condition, [M, F, Args, Reason]}, I) -> + %% There is a possibly huge type in Reason. + io_lib:format("The call ~w:~tw~ts ~ts\n", [M, F, a(Args, I), Reason]); %%----- Warnings for behaviour errors -------------------- -message_to_string({callback_type_mismatch, [B, F, A, ST, CT]}) -> - io_lib:format("The inferred return type of ~tw/~w (~ts) has nothing in" +message_to_string({callback_type_mismatch, [B, F, A, ST, CT]}, I) -> + io_lib:format("The inferred return type of ~tw/~w ~ts has nothing in" " common with ~ts, which is the expected return type for" - " the callback of the ~w behaviour\n", [F, A, ST, CT, B]); -message_to_string({callback_arg_type_mismatch, [B, F, A, N, ST, CT]}) -> + " the callback of the ~w behaviour\n", + [F, A, t("("++ST++")", I), t(CT, I), B]); +message_to_string({callback_arg_type_mismatch, [B, F, A, N, ST, CT]}, I) -> io_lib:format("The inferred type for the ~s argument of ~tw/~w (~ts) is" " not a supertype of ~ts, which is expected type for this" " argument in the callback of the ~w behaviour\n", - [ordinal(N), F, A, ST, CT, B]); -message_to_string({callback_spec_type_mismatch, [B, F, A, ST, CT]}) -> + [ordinal(N), F, A, t(ST, I), t(CT, I), B]); +message_to_string({callback_spec_type_mismatch, [B, F, A, ST, CT]}, I) -> io_lib:format("The return type ~ts in the specification of ~tw/~w is not a" " subtype of ~ts, which is the expected return type for the" - " callback of the ~w behaviour\n", [ST, F, A, CT, B]); -message_to_string({callback_spec_arg_type_mismatch, [B, F, A, N, ST, CT]}) -> + " callback of the ~w behaviour\n", + [t(ST, I), F, A, t(CT, I), B]); +message_to_string({callback_spec_arg_type_mismatch, [B, F, A, N, ST, CT]}, + I) -> io_lib:format("The specified type for the ~ts argument of ~tw/~w (~ts) is" " not a supertype of ~ts, which is expected type for this" " argument in the callback of the ~w behaviour\n", - [ordinal(N), F, A, ST, CT, B]); -message_to_string({callback_missing, [B, F, A]}) -> + [ordinal(N), F, A, t(ST, I), t(CT, I), B]); +message_to_string({callback_missing, [B, F, A]}, _I) -> io_lib:format("Undefined callback function ~tw/~w (behaviour ~w)\n", [F, A, B]); -message_to_string({callback_info_missing, [B]}) -> +message_to_string({callback_info_missing, [B]}, _I) -> io_lib:format("Callback info about the ~w behaviour is not available\n", [B]); %%----- Warnings for unknown functions, types, and behaviours ------------- -message_to_string({unknown_type, {M, F, A}}) -> +message_to_string({unknown_type, {M, F, A}}, _I) -> io_lib:format("Unknown type ~w:~tw/~w", [M, F, A]); -message_to_string({unknown_function, {M, F, A}}) -> +message_to_string({unknown_function, {M, F, A}}, _I) -> io_lib:format("Unknown function ~w:~tw/~w", [M, F, A]); -message_to_string({unknown_behaviour, B}) -> +message_to_string({unknown_behaviour, B}, _I) -> io_lib:format("Unknown behaviour ~w", [B]). %%----------------------------------------------------------------------------- @@ -494,7 +520,7 @@ message_to_string({unknown_behaviour, B}) -> %%----------------------------------------------------------------------------- call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, - {IsOverloaded, Contract}) -> + {IsOverloaded, Contract}, I) -> PositionString = form_position_string(ArgNs), case FailReason of only_sig -> @@ -502,24 +528,25 @@ call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, true -> %% We do not know which argument(s) caused the failure io_lib:format("will never return since the success typing arguments" - " are ~ts\n", [SigArgs]); + " are ~ts\n", [t(SigArgs, I)]); false -> io_lib:format("will never return since it differs in the ~s argument" " from the success typing arguments: ~ts\n", - [PositionString, SigArgs]) + [PositionString, t(SigArgs, I)]) end; only_contract -> case (ArgNs =:= []) orelse IsOverloaded of true -> %% We do not know which arguments caused the failure - io_lib:format("breaks the contract ~ts\n", [Contract]); + io_lib:format("breaks the contract ~ts\n", [sig(Contract, I)]); false -> io_lib:format("breaks the contract ~ts in the ~s argument\n", - [Contract, PositionString]) + [sig(Contract, I), PositionString]) end; both -> io_lib:format("will never return since the success typing is ~ts -> ~ts" - " and the contract is ~ts\n", [SigArgs, SigRet, Contract]) + " and the contract is ~ts\n", + [t(SigArgs, I), t(SigRet, I), sig(Contract, I)]) end. form_positions(ArgNs) -> @@ -534,24 +561,27 @@ form_positions(ArgNs) -> %% We know which positions N are to blame; %% the list of triples will never be empty. -form_expected_without_opaque([{N, T, TStr}]) -> +form_expected_without_opaque([{N, T, TStr}], I) -> case erl_types:t_is_opaque(T) of true -> - io_lib:format("an opaque term of type ~ts as ", [TStr]); + io_lib:format("an opaque term of type ~ts as ", [t(TStr, I)]); false -> - io_lib:format("a term of type ~ts (with opaque subterms) as ", [TStr]) + io_lib:format("a term of type ~ts (with opaque subterms) as ", + [t(TStr, I)]) end ++ form_position_string([N]) ++ " argument"; -form_expected_without_opaque(ExpectedTriples) -> %% TODO: can do much better here +form_expected_without_opaque(ExpectedTriples, _I) -> %% TODO: can do much better here {ArgNs, _Ts, _TStrs} = lists:unzip3(ExpectedTriples), "opaque terms as " ++ form_position_string(ArgNs) ++ " arguments". -form_expected(ExpectedArgs) -> +form_expected(ExpectedArgs, I) -> case ExpectedArgs of [T] -> TS = erl_types:t_to_string(T), case erl_types:t_is_opaque(T) of - true -> io_lib:format("an opaque term of type ~ts is expected", [TS]); - false -> io_lib:format("a structured term of type ~ts is expected", [TS]) + true -> io_lib:format("an opaque term of type ~ts is expected", + [t(TS, I)]); + false -> io_lib:format("a structured term of type ~ts is expected", + [t(TS, I)]) end; [_,_|_] -> "terms of different types are expected in these positions" end. @@ -571,3 +601,161 @@ ordinal(1) -> "1st"; ordinal(2) -> "2nd"; ordinal(3) -> "3rd"; ordinal(N) when is_integer(N) -> io_lib:format("~wth", [N]). + +%% Functions that parse type strings, literal strings, and contract +%% strings. Return strings formatted by erl_pp. + +%% If lib/hipe/cerl/erl_types.erl is compiled with DEBUG=true, +%% the contents of opaque types are showed inside brackets. +%% Since erl_parse:parse_form() cannot handle the bracket syntax, +%% no indentation is done. +%%-define(DEBUG , true). + +-define(IND, 10). + +con(M, F, Src, I) -> + S = sig(Src, I), + io_lib:format("~w:~tw~ts", [M, F, S]). + +sig(Src, false) -> + Src; +sig(Src, true) -> + Str = lists:flatten(io_lib:format("-spec ~w:~tw~ts.", [a, b, Src])), + {ok, Tokens, _EndLocation} = erl_scan:string(Str), + exec(fun() -> + {ok, {attribute, _, spec, {_MFA, Types}}} = + erl_parse:parse_form(Tokens), + indentation(?IND) ++ pp_spec(Types) + end, Src). + +%% Argument(list)s are a mix of types and Erlang code. Note: sometimes +%% (contract_range, call_without_opaque, opaque_type_test), the initial +%% newline is a bit out of place. +a(""=Args, _I) -> + Args; +a(Args, I) -> + t(Args, I). + +c(Cerl, _I) -> + Cerl. + +field_diffs(Src, false) -> + Src; +field_diffs(Src, true) -> + Fields = string:split(Src, " and "), + lists:join(" and ", [field_diff(Field) || Field <- Fields]). + +field_diff(Field) -> + [F | Ts] = string:split(Field, "::"), + F ++ " ::" ++ t(lists:flatten(lists:join("::", Ts)), true). + +rec_type("record "++Src, I) -> + "record " ++ t(Src, I). + +%% "variable"/"pattern" ++ cerl +ps("pattern "++Src, I) -> + "pattern " ++ t(Src, I); +ps("variable "++_=Src, _I) -> + Src; +ps("record field"++Rest, I) -> + [S, TypeStr] = string:split(Rest, "of type "), + "record field" ++ S ++ "of type " ++ t(TypeStr, I). + +%% Scan and parse a type or a literal, and pretty-print it using erl_pp. +t(Src, false) -> + Src; +t("("++_=Src, true) -> + ts(Src); +t(Src, true) -> + %% Binary types and products both start with a $<. + try parse_type_or_literal(Src) of + TypeOrLiteral -> + indentation(?IND) ++ pp_type(TypeOrLiteral) + catch + _:_ -> + ts(Src) + end. + +ts(Src) -> + Ind = indentation(?IND), + [C1|Src1] = Src, % $< (product) or $( (arglist) + [C2|RevSrc2] = lists:reverse(Src1), + Src2 = lists:reverse(RevSrc2), + exec(fun() -> + Types = parse_types_and_literals(Src2), + CommaInd = [$, | Ind], + (indentation(?IND-1) ++ + [C1 | lists:join(CommaInd, [pp_type(Type) || Type <- Types])] ++ + [C2]) + end, Src). + +-ifdef(DEBUG). +exec(F, R) -> + try F() catch _:_ -> R end. +-else. +exec(F, _) -> + F(). +-endif. + +indentation(I) -> + [$\n | lists:duplicate(I, $\s)]. + +pp_type(Type) -> + Form = {attribute, erl_anno:new(0), type, {t, Type, []}}, + TypeDef = erl_pp:form(Form, [{quote_singleton_atom_types, true}]), + {match, [S]} = re:run(TypeDef, <<"::\\s*(.*)\\.\\n*">>, + [{capture, all_but_first, list}, dotall]), + S. + +pp_spec(Spec) -> + Form = {attribute, erl_anno:new(0), spec, {{a,b,0}, Spec}}, + Sig = erl_pp:form(Form, [{quote_singleton_atom_types, true}]), + {match, [S]} = re:run(Sig, <<"-spec a:b\\s*(.*)\\.\\n*">>, + [{capture, all_but_first, list}, dotall]), + S. + +parse_types_and_literals(Src) -> + {ok, Tokens, _EndLocation} = erl_scan:string(Src), + [parse_a_type_or_literal(Ts) || Ts <- types(Tokens)]. + +parse_type_or_literal(Src) -> + {ok, Tokens, _EndLocation} = erl_scan:string(Src), + parse_a_type_or_literal(Tokens). + +parse_a_type_or_literal(Ts0) -> + L = erl_anno:new(1), + Ts = Ts0 ++ [{dot,L}], + Tokens = [{'-',L}, {atom,L,type}, {atom,L,t}, {'(',L}, {')',L}, + {'::',L}] ++ Ts, + case erl_parse:parse_form(Tokens) of + {ok, {attribute, _, type, {t, Type, []}}} -> + Type; + {error, _} -> + %% literal + {ok, [T]} = erl_parse:parse_exprs(Ts), + T + end. + +types([]) -> []; +types(Ts) -> + {Ts0, Ts1} = one_type(Ts, [], []), + [Ts0 | types(Ts1)]. + +one_type([], [], Ts) -> + {lists:reverse(Ts), []}; +one_type([{',', _Lc}|Toks], [], Ts0) -> + {lists:reverse(Ts0), Toks}; +one_type([{')', Lrp}|Toks], [], Ts0) -> + {lists:reverse(Ts0), [{')', Lrp}|Toks]}; +one_type([{'(', Llp}|Toks], E, Ts0) -> + one_type(Toks, [')'|E], [{'(', Llp}|Ts0]); +one_type([{'<<', Lls}|Toks], E, Ts0) -> + one_type(Toks, ['>>'|E], [{'<<', Lls}|Ts0]); +one_type([{'[', Lls}|Toks], E, Ts0) -> + one_type(Toks, [']'|E], [{'[', Lls}|Ts0]); +one_type([{'{', Llc}|Toks], E, Ts0) -> + one_type(Toks, ['}'|E], [{'{', Llc}|Ts0]); +one_type([{Rb, Lrb}|Toks], [Rb|E], Ts0) -> + one_type(Toks, E, [{Rb, Lrb}|Ts0]); +one_type([T|Toks], E, Ts0) -> + one_type(Toks, E, [T|Ts0]). diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index e7cf2860b7..4a12b9b671 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -108,6 +108,7 @@ -type dial_options() :: [dial_option()]. -type fopt() :: 'basename' | 'fullpath'. -type format() :: 'formatted' | 'raw'. +-type iopt() :: boolean(). -type label() :: non_neg_integer(). -type dial_warn_tags():: ordsets:ordset(dial_warn_tag()). -type rep_mode() :: 'quiet' | 'normal' | 'verbose'. @@ -119,6 +120,8 @@ %% Record declarations used by various files %%-------------------------------------------------------------------- +-define(INDENT_OPT, true). + -type doc_plt() :: 'undefined' | dialyzer_plt:plt(). -record(analysis, {analysis_pid :: pid() | 'undefined', @@ -154,6 +157,7 @@ output_file = none :: 'none' | file:filename(), output_format = formatted :: format(), filename_opt = basename :: fopt(), + indent_opt = ?INDENT_OPT :: iopt(), callgraph_file = "" :: file:filename(), check_plt = true :: boolean(), solvers = [] :: [solver()]}). diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 1e06d6e974..f887f661bd 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -40,6 +40,7 @@ output = standard_io :: io:device(), output_format = formatted :: format(), filename_opt = basename :: fopt(), + indent_opt = ?INDENT_OPT :: iopt(), output_plt = none :: 'none' | file:filename(), plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), @@ -588,8 +589,11 @@ new_state() -> init_output(State0, #options{output_file = OutFile, output_format = OutFormat, - filename_opt = FOpt}) -> - State = State0#cl_state{output_format = OutFormat, filename_opt = FOpt}, + filename_opt = FOpt, + indent_opt = IOpt}) -> + State = State0#cl_state{output_format = OutFormat, + filename_opt = FOpt, + indent_opt = IOpt}, case OutFile =:= none of true -> State; @@ -818,6 +822,7 @@ print_warnings(#cl_state{stored_warnings = []}) -> print_warnings(#cl_state{output = Output, output_format = Format, filename_opt = FOpt, + indent_opt = IOpt, stored_warnings = Warnings}) -> PrWarnings = process_warnings(Warnings), case PrWarnings of @@ -825,7 +830,8 @@ print_warnings(#cl_state{output = Output, [_|_] -> S = case Format of formatted -> - [dialyzer:format_warning(W, FOpt) || W <- PrWarnings]; + Opts = [{filename_opt, FOpt}, {indent_opt, IOpt}], + [dialyzer:format_warning(W, Opts) || W <- PrWarnings]; raw -> [io_lib:format("~tp. \n", [W]) || W <- set_warning_id(PrWarnings)] diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index f21eaed087..280cae81d5 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -134,6 +134,9 @@ cl(["--raw"|T]) -> cl(["--fullpath"|T]) -> put(dialyzer_filename_opt, fullpath), cl(T); +cl(["--no_indentation"|T]) -> + put(dialyzer_indent_opt, false), + cl(T); cl(["-pa", Path|T]) -> case code:add_patha(Path) of true -> cl(T); @@ -254,6 +257,7 @@ init() -> put(dialyzer_options_files, DefaultOpts#options.files), put(dialyzer_output_format, formatted), put(dialyzer_filename_opt, basename), + put(dialyzer_indent_opt, ?INDENT_OPT), put(dialyzer_options_check_plt, DefaultOpts#options.check_plt), put(dialyzer_timing, DefaultOpts#options.timing), put(dialyzer_solvers, DefaultOpts#options.solvers), @@ -295,6 +299,7 @@ cl_options() -> {output_file, get(dialyzer_output)}, {output_format, get(dialyzer_output_format)}, {filename_opt, get(dialyzer_filename_opt)}, + {indent_opt, get(dialyzer_indent_opt)}, {analysis_type, get(dialyzer_options_analysis_type)}, {get_warnings, get(dialyzer_options_get_warnings)}, {timing, get(dialyzer_timing)}, @@ -361,7 +366,7 @@ help_message() -> [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] [--dump_callgraph file] [--no_native] [--fullpath] - [--statistics] [--no_native_cache] + [--no_indentation] [--statistics] [--no_native_cache] Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the @@ -473,6 +478,9 @@ Options: caching. --fullpath Display the full path names of files for which warnings are emitted. + --no_indentation + Do not indent contracts and success typings. Note that this option has + no effect when combined with the --raw option. --gui Use the GUI. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 9c36d745c3..17b2168852 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -911,7 +911,6 @@ is_remote_types_related(Contract, CSig, Sig, MFA, RecDict) -> t_from_forms_without_remote([{FType, []}], MFA, RecDict) -> Site = {spec, MFA}, - %% FIXME Type1 = erl_types:t_from_form_without_remote(FType, Site, RecDict), {ok, erl_types:subst_all_vars_to_any(Type1)}; t_from_forms_without_remote([{_FType, _Constrs}], _MFA, _RecDict) -> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 45b4abb253..55c77814f8 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -405,8 +405,13 @@ handle_apply(Tree, Map, State) -> t_fun_args(OpType1, 'universe')), case any_none(NewArgs) of true -> + EnumNewArgs = lists:zip(lists:seq(1, length(NewArgs)), + NewArgs), + ArgNs = [Arg || + {Arg, Type} <- EnumNewArgs, t_is_none(Type)], Msg = {fun_app_args, - [format_args(Args, ArgTypes, State), + [ArgNs, + format_args(Args, ArgTypes, State), format_type(OpType, State)]}, State3 = state__add_warning(State2, ?WARN_FAILING_CALL, Tree, Msg), @@ -3639,14 +3644,15 @@ format_args(ArgList0, TypeList, State) -> "(" ++ format_args_1(ArgList, TypeList, State) ++ ")". format_args_1([Arg], [Type], State) -> - format_arg(Arg) ++ format_type(Type, State); + format_arg_1(Arg, Type, State); format_args_1([Arg|Args], [Type|Types], State) -> - String = - case cerl:is_literal(Arg) of - true -> format_cerl(Arg); - false -> format_arg(Arg) ++ format_type(Type, State) - end, - String ++ "," ++ format_args_1(Args, Types, State). + format_arg_1(Arg, Type, State) ++ "," ++ format_args_1(Args, Types, State). + +format_arg_1(Arg, Type, State) -> + case cerl:is_literal(Arg) of + true -> format_cerl(Arg); + false -> format_arg(Arg) ++ format_type(Type, State) + end. format_arg(Arg) -> Default = "", diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index b8414b7d8b..f47d90b91f 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -1135,7 +1135,9 @@ handle_help(State, Title, Txt) -> add_warnings(#gui_state{warnings_box = WarnBox, rawWarnings = RawWarns} = State, Warnings) -> NewRawWarns = RawWarns ++ Warnings, - WarnList = [dialyzer:format_warning(W) -- "\n" || W <- NewRawWarns], + %% The indentation cannot be turned off. + WarnList = [string:trim(dialyzer:format_warning(W), trailing) || + W <- NewRawWarns], wxListBox:set(WarnBox, WarnList), State#gui_state{rawWarnings = NewRawWarns}. diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index 03040f8e38..3b30036c1c 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -177,6 +177,8 @@ build_options([{OptionName, Value} = Term|Rest], Options) -> filename_opt -> assert_filename_opt(Value), build_options(Rest, Options#options{filename_opt = Value}); + indent_opt -> + build_options(Rest, Options#options{indent_opt = Value}); output_plt -> assert_filename(Value), build_options(Rest, Options#options{output_plt = Value}); diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 3fe026b096..245c099fef 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -46,6 +46,7 @@ ]). -include("dialyzer.hrl"). +-include("../../compiler/src/core_parse.hrl"). %%-define(DEBUG, true). @@ -751,9 +752,13 @@ pp_hook(Node, Ctxt, Cont) -> map -> pp_map(Node, Ctxt, Cont); literal -> - case is_map(cerl:concrete(Node)) of - true -> pp_map(Node, Ctxt, Cont); - false -> Cont(Node, Ctxt) + case cerl:concrete(Node) of + Map when is_map(Map) -> + pp_map(Node, Ctxt, Cont); + Bitstr when is_bitstring(Bitstr) -> + pp_binary(Node, Ctxt, Cont); + _ -> + Cont(Node, Ctxt) end; _ -> Cont(Node, Ctxt) @@ -761,7 +766,7 @@ pp_hook(Node, Ctxt, Cont) -> pp_binary(Node, Ctxt, Cont) -> prettypr:beside(prettypr:text("<<"), - prettypr:beside(pp_segments(cerl:binary_segments(Node), + prettypr:beside(pp_segments(cerl_binary_segments(Node), Ctxt, Cont), prettypr:text(">>"))). @@ -780,10 +785,29 @@ pp_segment(Node, Ctxt, Cont) -> Unit = cerl:bitstr_unit(Node), Type = cerl:bitstr_type(Node), Flags = cerl:bitstr_flags(Node), - prettypr:beside(Cont(Val, Ctxt), - prettypr:beside(pp_size(Size, Ctxt, Cont), - prettypr:beside(pp_opts(Type, Flags), - pp_unit(Unit, Ctxt, Cont)))). + RestPP = + case {concrete(Unit), concrete(Type), concrete(Flags)} of + {1, integer, [unsigned, big]} -> % Simplify common cases. + case concrete(Size) of + 8 -> prettypr:text(""); + _ -> pp_size(Size, Ctxt, Cont) + end; + {8, binary, [unsigned, big]} -> + SizePP = pp_size(Size, Ctxt, Cont), + prettypr:beside(SizePP, + prettypr:beside(prettypr:text("/"), pp_atom(Type))); + _What -> + SizePP = pp_size(Size, Ctxt, Cont), + UnitPP = pp_unit(Unit, Ctxt, Cont), + OptsPP = pp_opts(Type, Flags), + prettypr:beside(SizePP, prettypr:beside(OptsPP, UnitPP)) + end, + prettypr:beside(Cont(Val, Ctxt), RestPP). + +concrete(Cerl) -> + try cerl:concrete(Cerl) + catch _:_ -> anything_unexpected + end. pp_size(Size, Ctxt, Cont) -> case cerl:is_c_atom(Size) of @@ -859,6 +883,31 @@ seq([H | T], Separator, Ctxt, Fun) -> seq([], _, _, _) -> [prettypr:empty()]. +cerl_binary_segments(#c_literal{val = B}) when is_bitstring(B) -> + segs_from_bitstring(B); +cerl_binary_segments(CBinary) -> + cerl:binary_segments(CBinary). + +%% Copied from core_pp. The function cerl:binary_segments/2 should/could +%% be extended to handle literals, but then the cerl module cannot be +%% HiPE-compiled as of Erlang/OTP 22.0 (due to <<I:N>>). +segs_from_bitstring(<<H,T/bitstring>>) -> + [#c_bitstr{val=#c_literal{val=H}, + size=#c_literal{val=8}, + unit=#c_literal{val=1}, + type=#c_literal{val=integer}, + flags=#c_literal{val=[unsigned,big]}}|segs_from_bitstring(T)]; +segs_from_bitstring(<<>>) -> + []; +segs_from_bitstring(Bitstring) -> + N = bit_size(Bitstring), + <<I:N>> = Bitstring, + [#c_bitstr{val=#c_literal{val=I}, + size=#c_literal{val=N}, + unit=#c_literal{val=1}, + type=#c_literal{val=integer}, + flags=#c_literal{val=[unsigned,big]}}]. + %%------------------------------------------------------------------------------ -spec refold_pattern(cerl:cerl()) -> cerl:cerl(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options index 365b4798c5..83d4a0ec35 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, []}. +{dialyzer_options, [{indent_opt, false}]}. {time_limit, 5}. diff --git a/lib/dialyzer/test/callgraph_SUITE_data/dialyzer_options b/lib/dialyzer/test/callgraph_SUITE_data/dialyzer_options index 50991c9bc5..8413436b67 100644 --- a/lib/dialyzer/test/callgraph_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/callgraph_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, []}. +{dialyzer_options, [{indent_opt, false}]}. diff --git a/lib/dialyzer/test/dialyzer_common.erl b/lib/dialyzer/test/dialyzer_common.erl index 1a8403f486..beaf126344 100644 --- a/lib/dialyzer/test/dialyzer_common.erl +++ b/lib/dialyzer/test/dialyzer_common.erl @@ -147,7 +147,8 @@ check(TestCase, Opts, Dir, OutDir) -> try dialyzer:run([{files, Files},{from, src_code},{init_plt, PltFilename}, {check_plt, false}|ProperOpts]) of RawWarns -> - Warns = lists:sort([dialyzer:format_warning(W) || W <- RawWarns]), + Warns = lists:sort([dialyzer:format_warning(W, ProperOpts) || + W <- RawWarns]), case Warns of [] -> ok; _ -> diff --git a/lib/dialyzer/test/indent2_SUITE_data/dialyzer_options b/lib/dialyzer/test/indent2_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..ee07090337 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, [{warnings, [no_unused, no_return, specdiffs]}]}. diff --git a/lib/dialyzer/test/indent2_SUITE_data/results/arr b/lib/dialyzer/test/indent2_SUITE_data/results/arr new file mode 100644 index 0000000000..77e67f0cab --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/results/arr @@ -0,0 +1,15 @@ + +arr.erl:14: Type specification arr:test2 + (array:array(T), non_neg_integer(), T) -> array:array(T) is a supertype of the success typing: arr:test2 + (array:array(_), pos_integer(), _) -> array:array(_) +arr.erl:24: Type specification arr:test4 + (array:array(T), non_neg_integer(), _) -> array:array(T) is a supertype of the success typing: arr:test4 + (array:array(_), pos_integer(), _) -> array:array(_) +arr.erl:29: Type specification arr:test5 + (array:array(T), non_neg_integer(), T) -> array:array(T) is a supertype of the success typing: arr:test5 + (array:array(_), non_neg_integer(), integer()) -> + array:array(_) +arr.erl:37: Type specification arr:test6 + (array:array(integer()), non_neg_integer(), integer()) -> + array:array(any()) is not equal to the success typing: arr:test6 + (array:array(_), non_neg_integer(), _) -> array:array(_) diff --git a/lib/dialyzer/test/indent2_SUITE_data/results/iodata b/lib/dialyzer/test/indent2_SUITE_data/results/iodata new file mode 100644 index 0000000000..d95551d330 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/results/iodata @@ -0,0 +1,24 @@ + +iodata.erl:7: The specification for iodata:encode/2 states that the function might also return + binary() but the inferred return is + nonempty_maybe_improper_list(<<_:8, _:_*8>> | + nonempty_maybe_improper_list(<<_:8, + _:_*8>> | + nonempty_maybe_improper_list(any(), + <<_:8, + _:_*8>> | + []) | + byte(), + <<_:8, + _:_*8>> | + []) | + integer(), + <<_:8, _:_*8>> | []) | + integer() +iodata.erl:7: The success typing for iodata:encode/2 implies that the function might also return + integer() but the specification return is + binary() | + maybe_improper_list(binary() | + maybe_improper_list(any(), binary() | []) | + byte(), + binary() | []) diff --git a/lib/dialyzer/test/indent2_SUITE_data/results/remote b/lib/dialyzer/test/indent2_SUITE_data/results/remote new file mode 100644 index 0000000000..6decec6c6a --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/results/remote @@ -0,0 +1,25 @@ + +remotes1.erl:17: The specification for remotes1:foo5/1 states that the function might also return + 'ko' but the inferred return is + 'ok' +remotes1.erl:20: Type specification remotes1:foo6 + ('ok' | 'ko') -> 'ok' is a supertype of the success typing: remotes1:foo6 + ('ok') -> 'ok' +remotes1.erl:25: The specification for remotes1:foo7/1 states that the function might also return + 'ko' but the inferred return is + 'ok' +remotes1.erl:28: Type specification remotes1:foo8 + (local_type_42()) -> 'ok' is a supertype of the success typing: remotes1:foo8 + ('ok') -> 'ok' +remotes1.erl:33: The specification for remotes1:foo9/1 states that the function might also return + 'ko' but the inferred return is + 'ok' +remotes1.erl:36: Type specification remotes1:foo10 + (local_and_known_remote_type_42()) -> 'ok' is a supertype of the success typing: remotes1:foo10 + ('ok') -> 'ok' +remotes1.erl:49: Type specification remotes1:foo13 + ('ok') -> local_and_unknown_remote_type_42() is a supertype of the success typing: remotes1:foo13 + ('ok') -> 'ok' +remotes1.erl:52: Type specification remotes1:foo14 + (local_and_unknown_remote_type_42()) -> 'ok' is a supertype of the success typing: remotes1:foo14 + ('ok') -> 'ok' diff --git a/lib/dialyzer/test/indent2_SUITE_data/src/arr.erl b/lib/dialyzer/test/indent2_SUITE_data/src/arr.erl new file mode 100644 index 0000000000..3b265ccec2 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/src/arr.erl @@ -0,0 +1,41 @@ +-module(arr). + +%% http://erlang.org/pipermail/erlang-questions/2014-August/080445.html + +-define(A, array). + +-export([test/3, test2/3, test3/3, test4/3, test5/3, test6/3]). + +-spec test(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test2(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test2(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test3(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test3(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test4(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test4(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test5(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test5(Array, N, Value) when is_integer(Value) -> + ?A:set(N, Value, Array). + +%% One would ideally want a warning also for test6(), but the current +%% analysis of parametrized opaque types is not strong enough to +%% discover this. +-spec test6(?A:array(integer()), non_neg_integer(), integer()) -> + ?A:array(any()). + +test6(Array, N, Value) -> + ?A:set(N, Value, Array). diff --git a/lib/dialyzer/test/indent2_SUITE_data/src/iodata.erl b/lib/dialyzer/test/indent2_SUITE_data/src/iodata.erl new file mode 100644 index 0000000000..caa44f6c91 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/src/iodata.erl @@ -0,0 +1,41 @@ +-module(iodata). + +%% A small part of beam_asm. + +-export([encode/2]). + +-spec encode(non_neg_integer(), integer()) -> iodata(). % extra range binary() + +encode(Tag, N) when Tag >= 0, N < 0 -> + encode1(Tag, negative_to_bytes(N)); +encode(Tag, N) when Tag >= 0, N < 16 -> + (N bsl 4) bor Tag; % not in the specification +encode(Tag, N) when Tag >= 0, N < 16#800 -> + [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; +encode(Tag, N) when Tag >= 0 -> + encode1(Tag, to_bytes(N)). + +encode1(Tag, Bytes) -> + case iolist_size(Bytes) of + Num when 2 =< Num, Num =< 8 -> + [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; + Num when 8 < Num -> + [2#11111000 bor Tag, encode(0, Num-9)| Bytes] + end. + +to_bytes(N) -> + Bin = binary:encode_unsigned(N), + case Bin of + <<0:1,_/bits>> -> Bin; + <<1:1,_/bits>> -> [0,Bin] + end. + +negative_to_bytes(N) when N >= -16#8000 -> + <<N:16>>; +negative_to_bytes(N) -> + Bytes = byte_size(binary:encode_unsigned(-N)), + Bin = <<N:Bytes/unit:8>>, + case Bin of + <<0:1,_/bits>> -> [16#ff,Bin]; + <<1:1,_/bits>> -> Bin + end. diff --git a/lib/dialyzer/test/indent2_SUITE_data/src/remote/remotes1.erl b/lib/dialyzer/test/indent2_SUITE_data/src/remote/remotes1.erl new file mode 100644 index 0000000000..b722495095 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/src/remote/remotes1.erl @@ -0,0 +1,61 @@ +-module(remotes1). + +-compile(export_all). + +-spec foo1(some_unknown_remote:type42()) -> ok. +foo1(ok) -> ok. + +-spec foo2(ok) -> some_unknown_remote:type42(). +foo2(ok) -> ok. + +-spec foo3(some_known_remote:type42()) -> ok. +foo3(ok) -> ok. + +-spec foo4(ok) -> some_known_remote:type42(). +foo4(ok) -> ok. + +-spec foo5(ok|ko) -> ok|ko. +foo5(ok) -> ok. + +-spec foo6(ok|ko) -> ok. +foo6(ok) -> ok. + +-type local_type_42() :: ok | ko. + +-spec foo7(ok) -> local_type_42(). +foo7(ok) -> ok. + +-spec foo8(local_type_42()) -> ok. +foo8(ok) -> ok. + +-type local_and_known_remote_type_42() :: some_known_remote:type42() | ok | ko. + +-spec foo9(ok) -> local_and_known_remote_type_42(). +foo9(ok) -> ok. + +-spec foo10(local_and_known_remote_type_42()) -> ok. +foo10(ok) -> ok. + +-type local_and_ok_known_remote_type_42() :: some_known_remote:type42() | ok. + +-spec foo11(ok) -> local_and_ok_known_remote_type_42(). +foo11(ok) -> ok. + +-spec foo12(local_and_ok_known_remote_type_42()) -> ok. +foo12(ok) -> ok. + +-type local_and_unknown_remote_type_42() :: some_unknown_remote:type42() | ok | ko. + +-spec foo13(ok) -> local_and_unknown_remote_type_42(). +foo13(ok) -> ok. + +-spec foo14(local_and_unknown_remote_type_42()) -> ok. +foo14(ok) -> ok. + +-type local_and_ok_unknown_remote_type_42() :: some_unknown_remote:type42() | ok. + +-spec foo15(ok) -> local_and_ok_unknown_remote_type_42(). +foo15(ok) -> ok. + +-spec foo16(local_and_ok_unknown_remote_type_42()) -> ok. +foo16(ok) -> ok. diff --git a/lib/dialyzer/test/indent2_SUITE_data/src/remote/some_known_remote.erl b/lib/dialyzer/test/indent2_SUITE_data/src/remote/some_known_remote.erl new file mode 100644 index 0000000000..437f1e7826 --- /dev/null +++ b/lib/dialyzer/test/indent2_SUITE_data/src/remote/some_known_remote.erl @@ -0,0 +1,5 @@ +-module(some_known_remote). + +-export_type([type42/0]). + +-type type42() :: ok | ko. diff --git a/lib/dialyzer/test/indent_SUITE_data/dialyzer_options b/lib/dialyzer/test/indent_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..7c088f9a65 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, [{warnings, [no_unused, no_return, race_conditions]}]}. diff --git a/lib/dialyzer/test/indent_SUITE_data/results/abs b/lib/dialyzer/test/indent_SUITE_data/results/abs new file mode 100644 index 0000000000..ac663a4e80 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/abs @@ -0,0 +1,13 @@ + +abs.erl:16: The pattern + 'true' can never match the type + 'false' +abs.erl:27: The pattern + 'true' can never match the type + 'false' +abs.erl:37: The pattern + 'true' can never match the type + 'false' +abs.erl:49: The pattern + 'true' can never match the type + 'false' diff --git a/lib/dialyzer/test/indent_SUITE_data/results/app_call b/lib/dialyzer/test/indent_SUITE_data/results/app_call new file mode 100644 index 0000000000..729587b5c6 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/app_call @@ -0,0 +1,9 @@ + +app_call.erl:6: The call M:'foo' + () requires that M is of type + atom() not + 42 +app_call.erl:9: The call 'mod':F + () requires that F is of type + atom() not + {'gazonk', []} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/arr b/lib/dialyzer/test/indent_SUITE_data/results/arr new file mode 100644 index 0000000000..9497d12eec --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/arr @@ -0,0 +1,4 @@ + +arr.erl:14: Type specification arr:test2(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test2(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:24: Type specification arr:test4(array:array(T),non_neg_integer(),_) -> array:array(T) is a supertype of the success typing: arr:test4(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:29: Type specification arr:test5(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test5(array:array(_),non_neg_integer(),integer()) -> array:array(_) diff --git a/lib/dialyzer/test/indent_SUITE_data/results/blame_contract_range b/lib/dialyzer/test/indent_SUITE_data/results/blame_contract_range new file mode 100644 index 0000000000..287d23d91f --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/blame_contract_range @@ -0,0 +1,8 @@ + +blame_contract_range.erl:14: The contract blame_contract_range:bar + (atom()) -> 'a' cannot be right because the inferred return for bar + ('b') on line 12 is + 'b' +blame_contract_range.erl:15: The pattern + 'a' can never match the type + 'b' diff --git a/lib/dialyzer/test/indent_SUITE_data/results/bs_fail_constr b/lib/dialyzer/test/indent_SUITE_data/results/bs_fail_constr new file mode 100644 index 0000000000..86f1329bf3 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/bs_fail_constr @@ -0,0 +1,9 @@ + +bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S has type + neg_integer() +bs_fail_constr.erl:15: Binary construction will fail since the value field V in segment V/utf32 has type + float() +bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V has type + float() +bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary has type + atom() diff --git a/lib/dialyzer/test/indent_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/indent_SUITE_data/results/callbacks_and_specs new file mode 100644 index 0000000000..dd9d3397d2 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/callbacks_and_specs @@ -0,0 +1,23 @@ + +my_callbacks_wrong.erl:26: The return type + #state{parent :: pid(), + status :: 'closed' | 'init' | 'open', + subscribe :: [{pid(), integer()}], + counter :: integer()} in the specification of callback_init/1 is not a subtype of + {'ok', _}, which is the expected return type for the callback of the my_behaviour behaviour +my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 + (#state{parent :: pid(), + status :: 'init', + subscribe :: [], + counter :: 1}) has nothing in common with + {'ok', _}, which is the expected return type for the callback of the my_behaviour behaviour +my_callbacks_wrong.erl:30: The return type + {'reply', + #state{parent :: pid(), + status :: 'closed' | 'init' | 'open', + subscribe :: [{pid(), integer()}], + counter :: integer()}} in the specification of callback_cast/3 is not a subtype of + {'noreply', _}, which is the expected return type for the callback of the my_behaviour behaviour +my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 ( + atom()) is not a supertype of + pid(), which is expected type for this argument in the callback of the my_behaviour behaviour diff --git a/lib/dialyzer/test/indent_SUITE_data/results/contract3 b/lib/dialyzer/test/indent_SUITE_data/results/contract3 new file mode 100644 index 0000000000..6e111f87d9 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/contract3 @@ -0,0 +1,3 @@ + +contract3.erl:17: Overloaded contract for contract3:t1/1 has overlapping domains; such contracts are currently unsupported and are simply ignored +contract3.erl:29: Overloaded contract for contract3:t3/3 has overlapping domains; such contracts are currently unsupported and are simply ignored diff --git a/lib/dialyzer/test/indent_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/indent_SUITE_data/results/contracts_with_subtypes new file mode 100644 index 0000000000..737959a49d --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/contracts_with_subtypes @@ -0,0 +1,142 @@ + +contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg + ({'a', 'b'}) breaks the contract + (Arg) -> 'ok' + when + Arg :: {'a', A} | {'b', B}, + A :: 'a' | {'b', B}, + B :: 'b' | {'a', A} +contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg + ({'b', 'a'}) breaks the contract + (Arg) -> 'ok' + when + Arg :: {'a', A} | {'b', B}, + A :: 'a' | {'b', B}, + B :: 'b' | {'a', A} +contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg + ({'b', {'a', 'b'}}) breaks the contract + (Arg) -> 'ok' + when + Arg :: {'a', A} | {'b', B}, + A :: 'a' | {'b', B}, + B :: 'b' | {'a', A} +contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2 + ({'a', 'b'}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2 + ({'b', 'a'}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2 + ({'a', {'b', 'a'}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2 + ({'b', {'a', 'b'}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2 + ({'a', {'b', {'a', 'b'}}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2 + ({'b', {'a', {'b', 'a'}}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2 + ({'a', {'b', {'a', {'b', 'a'}}}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2 + ({'b', {'a', {'b', {'a', 'b'}}}}) breaks the contract + (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:175: The pattern + 1 can never match the type + string() +contracts_with_subtypes.erl:178: The pattern + 'alpha' can never match the type + {'ok', _} | {'ok', _, string()} +contracts_with_subtypes.erl:180: The pattern + 42 can never match the type + {'ok', _} | {'ok', _, string()} +contracts_with_subtypes.erl:196: The pattern + 'alpha' can never match the type + {'ok', _} +contracts_with_subtypes.erl:198: The pattern + 42 can never match the type + {'ok', _} +contracts_with_subtypes.erl:216: The pattern + 'alpha' can never match the type + {'ok', _} +contracts_with_subtypes.erl:218: The pattern + 42 can never match the type + {'ok', _} +contracts_with_subtypes.erl:235: The pattern + 1 can never match the type + string() +contracts_with_subtypes.erl:238: The pattern + {'ok', _} can never match the type + {'ok', _, string()} +contracts_with_subtypes.erl:239: The pattern + 'alpha' can never match the type + {'ok', _, string()} +contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is + () -> 'something' +contracts_with_subtypes.erl:240: The pattern + {'ok', 42} can never match the type + {'ok', _, string()} +contracts_with_subtypes.erl:241: The pattern + 42 can never match the type + {'ok', _, string()} +contracts_with_subtypes.erl:268: The call contracts_with_subtypes:flat_ets_new + (12, + []) breaks the contract + (Name, Options) -> atom() + when + Name :: atom(), + Options :: [Option], + Option :: + 'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | + 'public' | 'protected' | 'private' | + 'named_table' | + {'keypos', integer()} | + {'heir', pid(), term()} | + {'heir', 'none'} | + {'write_concurrency', boolean()} | + {'read_concurrency', boolean()} | + 'compressed' +contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new + (12, + []) breaks the contract + (Name, Options) -> atom() + when + Name :: atom(), + Options :: [Option], + Option :: + Type | Access | 'named_table' | + {'keypos', Pos} | + {'heir', Pid :: pid(), HeirData} | + {'heir', 'none'} | + Tweaks, + Type :: type(), + Access :: access(), + Tweaks :: + {'write_concurrency', boolean()} | + {'read_concurrency', boolean()} | + 'compressed', + Pos :: pos_integer(), + HeirData :: term() +contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1 + (5) breaks the contract + (Arg1) -> Res when Arg1 :: atom(), Res :: atom() +contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2 + (5) breaks the contract + (Arg1) -> Res when Arg1 :: Arg2, Arg2 :: atom(), Res :: atom() +contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3 + (5) breaks the contract + (Arg1) -> Res when Arg2 :: atom(), Arg1 :: Arg2, Res :: atom() +contracts_with_subtypes.erl:7: Invalid type specification for function contracts_with_subtypes:extract/0. The success typing is + () -> 'something' +contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4 + (5) breaks the contract + (Type) -> Type when Type :: atom() +contracts_with_subtypes.erl:81: The call contracts_with_subtypes:foo5 + (5) breaks the contract + (Type :: atom()) -> Type :: atom() +contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6 + (5) breaks the contract + (Type) -> Type when Type :: atom() diff --git a/lib/dialyzer/test/indent_SUITE_data/results/dict_use b/lib/dialyzer/test/indent_SUITE_data/results/dict_use new file mode 100644 index 0000000000..c6863d057e --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/dict_use @@ -0,0 +1,48 @@ + +dict_use.erl:41: The attempt to match a term of type + dict:dict(_, _) against the pattern + 'gazonk' breaks the opacity of the term +dict_use.erl:45: The attempt to match a term of type + dict:dict(_, _) against the pattern + [] breaks the opacity of the term +dict_use.erl:46: The attempt to match a term of type + dict:dict(_, _) against the pattern + 42 breaks the opacity of the term +dict_use.erl:51: The attempt to match a term of type + dict:dict(_, _) against the pattern + [] breaks the opacity of the term +dict_use.erl:52: The attempt to match a term of type + dict:dict(_, _) against the pattern + 42 breaks the opacity of the term +dict_use.erl:58: Attempt to test for equality between a term of type + maybe_improper_list() and a term of opaque type + dict:dict(_, _) +dict_use.erl:60: Attempt to test for inequality between a term of type + atom() and a term of opaque type + dict:dict(_, _) +dict_use.erl:64: Guard test length + (D :: dict:dict(_, _)) breaks the opacity of its argument +dict_use.erl:65: Guard test is_atom + (D :: dict:dict(_, _)) breaks the opacity of its argument +dict_use.erl:66: Guard test is_list + (D :: dict:dict(_, _)) breaks the opacity of its argument +dict_use.erl:70: The type test is_list + (dict:dict(_, _)) breaks the opacity of the term + dict:dict(_, _) +dict_use.erl:73: The call dict:fetch + ('foo', + [1, 2, 3]) does not have an opaque term of type + dict:dict(_, _) as 2nd argument +dict_use.erl:76: The call dict:merge + (Fun :: any(), + 42, + [1, 2]) does not have opaque terms as 2nd and 3rd arguments +dict_use.erl:79: The call dict:store + (42, + 'elli', + {'dict', 0, 16, 16, 8, 80, 48, + {[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], + []}, + {{[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], + []}}}) does not have an opaque term of type + dict:dict(_, _) as 3rd argument diff --git a/lib/dialyzer/test/indent_SUITE_data/results/fun_app b/lib/dialyzer/test/indent_SUITE_data/results/fun_app new file mode 100644 index 0000000000..d4a3caf749 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/fun_app @@ -0,0 +1,7 @@ + +fun_app.erl:37: Fun application will fail since F :: + fun((_, _, _) -> 'ok' | 'true') is not a function of arity 1 +fun_app.erl:38: Fun application will fail since F :: + fun((_, _, _) -> 'ok' | 'true') is not a function of arity 2 +fun_app.erl:40: Fun application will fail since F :: + fun((_, _, _) -> 'ok' | 'true') is not a function of arity 4 diff --git a/lib/dialyzer/test/indent_SUITE_data/results/fun_app_args b/lib/dialyzer/test/indent_SUITE_data/results/fun_app_args new file mode 100644 index 0000000000..ac1bbb62b8 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/fun_app_args @@ -0,0 +1,5 @@ + +fun_app_args.erl:12: Fun application with arguments + ('b', + []) will fail since the function has type + 'c' | fun(('a', []) -> any()), which differs in the 1st argument diff --git a/lib/dialyzer/test/indent_SUITE_data/results/guard_update b/lib/dialyzer/test/indent_SUITE_data/results/guard_update new file mode 100644 index 0000000000..bd0e8cd5dd --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/guard_update @@ -0,0 +1,6 @@ + +guard_update.erl:6: The call guard_update:f + (#{'a' => 2}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'b' := _, _ => _}) +guard_update.erl:8: Clause guard cannot succeed. The variable M was matched against the type + #{'a' := 2} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/guard_warnings b/lib/dialyzer/test/indent_SUITE_data/results/guard_warnings new file mode 100644 index 0000000000..a6cb54ff9c --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/guard_warnings @@ -0,0 +1,134 @@ + +guard_warnings.erl:100: Guard test not + ('true') can never succeed +guard_warnings.erl:102: Guard test + X :: 'true' =:= + 'false' can never succeed +guard_warnings.erl:104: Guard test + X :: 'true' == + 'false' can never succeed +guard_warnings.erl:106: Guard test + X :: 'true' =/= + 'true' can never succeed +guard_warnings.erl:12: Guard test + X :: 'true' =:= + 'false' can never succeed +guard_warnings.erl:14: Guard test + X :: 'false' =:= + 'true' can never succeed +guard_warnings.erl:16: Guard test not + (X :: 'true') can never succeed +guard_warnings.erl:18: Guard test and + ('true', + X :: none()) can never succeed +guard_warnings.erl:20: Guard test not + (X :: 'true') can never succeed +guard_warnings.erl:22: Guard test and + ('true', + X :: none()) can never succeed +guard_warnings.erl:28: Guard test not(not + (X :: 'false')) can never succeed +guard_warnings.erl:30: Guard test not(or + ('false', + X :: none())) can never succeed +guard_warnings.erl:32: Guard test not(not + (X :: 'false')) can never succeed +guard_warnings.erl:34: Guard test not(or + ('false', + X :: none())) can never succeed +guard_warnings.erl:36: Guard test and + ('true', + 'false') can never succeed +guard_warnings.erl:38: Guard test and + ('false', + any()) can never succeed +guard_warnings.erl:40: Guard test and + (X :: 'true', + 'false') can never succeed +guard_warnings.erl:42: Guard test and + ('false', + X :: any()) can never succeed +guard_warnings.erl:44: Guard test and + (X :: 'true', + 'false') can never succeed +guard_warnings.erl:46: Guard test and + ('false', + X :: any()) can never succeed +guard_warnings.erl:48: Guard test not(or + ('true', + any())) can never succeed +guard_warnings.erl:50: Guard test not(or + ('false', + 'true')) can never succeed +guard_warnings.erl:52: Guard test not(or + ('true', + X :: any())) can never succeed +guard_warnings.erl:54: Guard test not(or + (X :: 'false', + 'true')) can never succeed +guard_warnings.erl:56: Guard test not(or + ('true', + X :: any())) can never succeed +guard_warnings.erl:58: Guard test not(or + (X :: 'false', + 'true')) can never succeed +guard_warnings.erl:60: Guard test and + ('false', + any()) can never succeed +guard_warnings.erl:62: Guard test and + ('true', + 'false') can never succeed +guard_warnings.erl:64: Guard test and + ('false', + X :: any()) can never succeed +guard_warnings.erl:66: Guard test and + (X :: 'true', + 'false') can never succeed +guard_warnings.erl:68: Guard test and + ('false', + X :: any()) can never succeed +guard_warnings.erl:70: Guard test and + (X :: 'true', + 'false') can never succeed +guard_warnings.erl:72: Guard test and + ('false', + 'false') can never succeed +guard_warnings.erl:74: Guard test and + ('false', + 'false') can never succeed +guard_warnings.erl:76: Guard test not(and + ('true', + 'true')) can never succeed +guard_warnings.erl:78: Guard test and + ('false', + 'false') can never succeed +guard_warnings.erl:80: Guard test not(and + ('true', + 'true')) can never succeed +guard_warnings.erl:82: Guard test or + ('false', + 'false') can never succeed +guard_warnings.erl:84: Guard test or + ('false', + 'false') can never succeed +guard_warnings.erl:86: Guard test or + ('false', + 'false') can never succeed +guard_warnings.erl:88: Guard test or + ('false', + 'false') can never succeed +guard_warnings.erl:90: Guard test or + ('false', + 'false') can never succeed +guard_warnings.erl:92: Guard test + 'true' =:= + 'false' can never succeed +guard_warnings.erl:94: Guard test + 'true' == + 'false' can never succeed +guard_warnings.erl:96: Guard test + 'true' =:= + 'false' can never succeed +guard_warnings.erl:98: Guard test not( + 'true' == + 'true') can never succeed diff --git a/lib/dialyzer/test/indent_SUITE_data/results/map_galore b/lib/dialyzer/test/indent_SUITE_data/results/map_galore new file mode 100644 index 0000000000..1b63e28ace --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/map_galore @@ -0,0 +1,713 @@ + +map_galore.erl:1000: A key of type + 42 cannot exist in a map of type + #{1 := 'a', + 2 := 'b', + 4 := 'd', + 5 := 'e', + float() => 'c' | 'v'} +map_galore.erl:1080: A key of type + 'nonexisting' cannot exist in a map of type + #{10 := 'a0', + 11 := 'a1', + 12 := 'a2', + 13 := 'a3', + 14 := 'a4', + 15 := 'a5', + 16 := 'a6', + 17 := 'a7', + 18 := 'a8', + 19 := 'a9', + 20 := 'b0', + 21 := 'b1', + 22 := 'b2', + 23 := 'b3', + 24 := 'b4', + 25 := 'b5', + 26 := 'b6', + 27 := 'b7', + 28 := 'b8', + 29 := 'b9', + 30 := [48 | 99, ...], + 31 := [49 | 99, ...], + 32 := [50 | 99, ...], + 33 := [51 | 99, ...], + 34 := [52 | 99, ...], + 35 := [53 | 99, ...], + 36 := [54 | 99, ...], + 37 := [55 | 99, ...], + 38 := [56 | 99, ...], + 39 := [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [54 | 99, ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} => + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | + 100 | 101, + ...]} => + atom() | [1..255, ...]} +map_galore.erl:1082: A key of type + 42 cannot exist in a map of type + #{10 := 'a0', + 11 := 'a1', + 12 := 'a2', + 13 := 'a3', + 14 := 'a4', + 15 := 'a5', + 16 := 'a6', + 17 := 'a7', + 18 := 'a8', + 19 := 'a9', + 20 := 'b0', + 21 := 'b1', + 22 := 'b2', + 23 := 'b3', + 24 := 'b4', + 25 := 'b5', + 26 := 'b6', + 27 := 'b7', + 28 := 'b8', + 29 := 'b9', + 30 := [48 | 99, ...], + 31 := [49 | 99, ...], + 32 := [50 | 99, ...], + 33 := [51 | 99, ...], + 34 := [52 | 99, ...], + 35 := [53 | 99, ...], + 36 := [54 | 99, ...], + 37 := [55 | 99, ...], + 38 := [56 | 99, ...], + 39 := [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [54 | 99, ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} => + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | + 100 | 101, + ...]} => + atom() | [1..255, ...]} +map_galore.erl:1140: The call map_galore:map_guard_sequence_1 + (#{seq => 6, val => "e"}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'seq' := 1 | 2 | 3 | 4 | 5, + 'val' := [97 | 98 | 99 | 100 | 101, ...], + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[any(), ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [any(), ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [any(), ...], + 31 => [any(), ...], + 32 => [any(), ...], + 33 => [any(), ...], + 34 => [any(), ...], + 35 => [any(), ...], + 36 => [any(), ...], + 37 => [any(), ...], + 38 => [any(), ...], + 39 => [any(), ...], + <<_:16>> | [any(), ...] | {_} => [any(), ...]} => + atom() | [1..255, ...]}) +map_galore.erl:1141: The call map_galore:map_guard_sequence_2 + (#{'b' => 5}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'a' := 'gg' | 'kk' | 'sc' | 3 | 4, + 'b' => 'other' | 3 | 4 | 5, + 'c' => 'sc2', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[any(), ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [any(), ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [any(), ...], + 31 => [any(), ...], + 32 => [any(), ...], + 33 => [any(), ...], + 34 => [any(), ...], + 35 => [any(), ...], + 36 => [any(), ...], + 37 => [any(), ...], + 38 => [any(), ...], + 39 => [any(), ...], + <<_:16>> | [any(), ...] | {_} => [any(), ...]} => + atom() | [1..255, ...]}) +map_galore.erl:1209: The call map_galore:map_guard_sequence_1 + (#{'seq' := 6, + 'val' := [101, ...], + 10 := 'a0', + 11 := 'a1', + 12 := 'a2', + 13 := 'a3', + 14 := 'a4', + 15 := 'a5', + 16 := 'a6', + 17 := 'a7', + 18 := 'a8', + 19 := 'a9', + 20 := 'b0', + 21 := 'b1', + 22 := 'b2', + 23 := 'b3', + 24 := 'b4', + 25 := 'b5', + 26 := 'b6', + 27 := 'b7', + 28 := 'b8', + 29 := 'b9', + 30 := [48 | 99, ...], + 31 := [49 | 99, ...], + 32 := [50 | 99, ...], + 33 := [51 | 99, ...], + 34 := [52 | 99, ...], + 35 := [53 | 99, ...], + 36 := [54 | 99, ...], + 37 := [55 | 99, ...], + 38 := [56 | 99, ...], + 39 := [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | 3, + ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [54 | 99, ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} => + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | + 100 | 101, + ...]} => + atom() | [1..255, ...]}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'seq' := 1 | 2 | 3 | 4 | 5, + 'val' := [97 | 98 | 99 | 100 | 101, ...], + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[any(), ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [any(), ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [any(), ...], + 31 => [any(), ...], + 32 => [any(), ...], + 33 => [any(), ...], + 34 => [any(), ...], + 35 => [any(), ...], + 36 => [any(), ...], + 37 => [any(), ...], + 38 => [any(), ...], + 39 => [any(), ...], + <<_:16>> | [any(), ...] | {_} => [any(), ...]} => + atom() | [1..255, ...]}) +map_galore.erl:1210: The call map_galore:map_guard_sequence_2 + (#{'b' := 5, + 10 := 'a0', + 11 := 'a1', + 12 := 'a2', + 13 := 'a3', + 14 := 'a4', + 15 := 'a5', + 16 := 'a6', + 17 := 'a7', + 18 := 'a8', + 19 := 'a9', + 20 := 'b0', + 21 := 'b1', + 22 := 'b2', + 23 := 'b3', + 24 := 'b4', + 25 := 'b5', + 26 := 'b6', + 27 := 'b7', + 28 := 'b8', + 29 := 'b9', + 30 := [48 | 99, ...], + 31 := [49 | 99, ...], + 32 := [50 | 99, ...], + 33 := [51 | 99, ...], + 34 := [52 | 99, ...], + 35 := [53 | 99, ...], + 36 := [54 | 99, ...], + 37 := [55 | 99, ...], + 38 := [56 | 99, ...], + 39 := [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | 3, + ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [54 | 99, ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...], + ...]} => + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | + 100 | 101, + ...]} => + atom() | [1..255, ...]}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'a' := 'gg' | 'kk' | 'sc' | 3 | 4, + 'b' => 'other' | 3 | 4 | 5, + 'c' => 'sc2', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [48 | 99, ...], + 31 => [49 | 99, ...], + 32 => [50 | 99, ...], + 33 => [51 | 99, ...], + 34 => [52 | 99, ...], + 35 => [53 | 99, ...], + 36 => [54 | 99, ...], + 37 => [55 | 99, ...], + 38 => [56 | 99, ...], + 39 => [57 | 99, ...], + <<_:16>> | + [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57, ...] | + float() | + {[any(), ...]} | + #{'k16' => 'a6', + 'k26' => 'b6', + 'k36' => [any(), ...], + 'map' => 'key', + 'one' => 'small', + 'second' => 'small', + 'third' => 'small', + 10 => 'a0', + 11 => 'a1', + 12 => 'a2', + 13 => 'a3', + 14 => 'a4', + 15 => 'a5', + 16 => 'a6', + 17 => 'a7', + 18 => 'a8', + 19 => 'a9', + 20 => 'b0', + 21 => 'b1', + 22 => 'b2', + 23 => 'b3', + 24 => 'b4', + 25 => 'b5', + 26 => 'b6', + 27 => 'b7', + 28 => 'b8', + 29 => 'b9', + 30 => [any(), ...], + 31 => [any(), ...], + 32 => [any(), ...], + 33 => [any(), ...], + 34 => [any(), ...], + 35 => [any(), ...], + 36 => [any(), ...], + 37 => [any(), ...], + 38 => [any(), ...], + 39 => [any(), ...], + <<_:16>> | [any(), ...] | {_} => [any(), ...]} => + atom() | [1..255, ...]}) +map_galore.erl:1418: Fun application with arguments + (#{'s' => 'none', 'v' => 'none'}) will never return since it differs in the 1st argument from the success typing arguments: + (#{'s' := 'l' | 't' | 'v', + 'v' := + 'none' | + <<_:16>> | + [<<_:16>>, ...] | + {<<_:16>>, <<_:16>>}}) +map_galore.erl:1491: The test + #{} =:= + #{'a' := 1} can never evaluate to 'true' +map_galore.erl:1492: The test + #{'a' := 1} =:= + #{} can never evaluate to 'true' +map_galore.erl:1495: The test + #{'a' := 1} =:= + #{'a' := 2} can never evaluate to 'true' +map_galore.erl:1496: The test + #{'a' := 2} =:= + #{'a' := 1} can never evaluate to 'true' +map_galore.erl:1497: The test + #{'a' := 2, 'b' := 1} =:= + #{'a' := 1, 'b' := 3} can never evaluate to 'true' +map_galore.erl:1498: The test + #{'a' := 1, 'b' := 1} =:= + #{'a' := 1, 'b' := 3} can never evaluate to 'true' +map_galore.erl:1762: The call maps:get + ({1, 1}, + #{{1, float()} => [101 | 108 | 112 | 116 | 117, ...]}) will never return since the success typing arguments are + (any(), + map()) +map_galore.erl:1763: The call maps:get + ('a', + #{}) will never return since the success typing arguments are + (any(), + map()) +map_galore.erl:1765: The call maps:get + ('a', + #{'b' => 1, 'c' => 2}) will never return since the success typing arguments are + (any(), + map()) +map_galore.erl:186: The pattern + #{'x' := 2} can never match the type + #{'x' := 3} +map_galore.erl:187: The pattern + #{'x' := 3} can never match the type + {'a', 'b', 'c'} +map_galore.erl:188: The pattern + #{'x' := 3} can never match the type + #{'y' := 3} +map_galore.erl:189: The pattern + #{'x' := 3} can never match the type + #{'x' := [101 | 104 | 114 | 116, ...]} +map_galore.erl:2280: Cons will produce an improper list since its 2nd argument is + {'b', 'a'} +map_galore.erl:2280: The call maps:from_list + ([{'a', 'b'} | {'b', 'a'}]) will never return since it differs in the 1st argument from the success typing arguments: + ([{_, _}]) +map_galore.erl:2281: The call maps:from_list + ('a') will never return since it differs in the 1st argument from the success typing arguments: + ([{_, _}]) +map_galore.erl:2282: The call maps:from_list + (42) will never return since it differs in the 1st argument from the success typing arguments: + ([{_, _}]) +map_galore.erl:997: A key of type + 'nonexisting' cannot exist in a map of type + #{} +map_galore.erl:998: A key of type + 'nonexisting' cannot exist in a map of type + #{1 := 'a', 2 := 'b', 4 := 'd', 5 := 'e', float() => 'c'} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/order b/lib/dialyzer/test/indent_SUITE_data/results/order new file mode 100644 index 0000000000..5b0030d7b1 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/order @@ -0,0 +1,23 @@ + +order.erl:14: Guard test is_integer + (Int :: 'b') can never succeed +order.erl:16: The variable _Else can never match since previous clauses completely covered the type + 'b' +order.erl:21: Guard test is_integer + (Int :: 'b') can never succeed +order.erl:23: The variable _Else can never match since previous clauses completely covered the type + 'b' +order.erl:30: The variable _Else can never match since previous clauses completely covered the type + 'b' | 1 +order.erl:36: The variable Atom can never match since previous clauses completely covered the type + 1 +order.erl:37: The variable _Else can never match since previous clauses completely covered the type + 1 +order.erl:42: Guard test is_integer + (Int :: 'b') can never succeed +order.erl:44: The variable _Else can never match since previous clauses completely covered the type + 'b' +order.erl:7: Guard test is_integer + (Int :: 'b') can never succeed +order.erl:9: The variable _Else can never match since previous clauses completely covered the type + 'b' diff --git a/lib/dialyzer/test/indent_SUITE_data/results/queue_use b/lib/dialyzer/test/indent_SUITE_data/results/queue_use new file mode 100644 index 0000000000..b6604e5320 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/queue_use @@ -0,0 +1,34 @@ + +queue_use.erl:18: The call queue:is_empty + ({[], []}) does not have an opaque term of type + queue:queue(_) as 1st argument +queue_use.erl:22: The call queue:in + (42, + Q0 :: {[], []}) does not have an opaque term of type + queue:queue(_) as 2nd argument +queue_use.erl:27: The attempt to match a term of type + queue:queue(_) against the pattern + {"*", Q2} breaks the opacity of the term +queue_use.erl:33: Attempt to test for equality between a term of type + {[42, ...], []} and a term of opaque type + queue:queue(_) +queue_use.erl:36: The attempt to match a term of type + queue:queue(_) against the pattern + {F, _R} breaks the opacity of the term +queue_use.erl:40: The call queue:out + ({"*", []}) does not have an opaque term of type + queue:queue(_) as 1st argument +queue_use.erl:51: The call queue_use:is_in_queue + (E :: 42, + DB :: #db{p :: [], q :: queue:queue(_)}) contains an opaque term as 2nd argument when terms of different types are expected in these positions +queue_use.erl:56: The attempt to match a term of type + #db{p :: [], q :: queue:queue(_)} against the pattern + {'db', _, {L1, L2}} breaks the opacity of + queue:queue(_) +queue_use.erl:62: The call queue_use:tuple_queue + ({42, 'gazonk'}) does not have a term of type + {_, queue:queue(_)} (with opaque subterms) as 1st argument +queue_use.erl:65: The call queue:in + (F :: 42, + Q :: 'gazonk') does not have an opaque term of type + queue:queue(_) as 2nd argument diff --git a/lib/dialyzer/test/indent_SUITE_data/results/rec b/lib/dialyzer/test/indent_SUITE_data/results/rec new file mode 100644 index 0000000000..5938b18be0 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/rec @@ -0,0 +1,15 @@ + +rec_use.erl:17: The attempt to match a term of type + rec_adt:rec() against the pattern + {'rec', _, 42} breaks the opacity of the term +rec_use.erl:18: Guard test tuple_size + (R :: rec_adt:rec()) breaks the opacity of its argument +rec_use.erl:23: The call rec_adt:get_a + (R :: tuple()) does not have an opaque term of type + rec_adt:rec() as 1st argument +rec_use.erl:27: Attempt to test for equality between a term of type + {'rec', 'gazonk', 42} and a term of opaque type + rec_adt:rec() +rec_use.erl:30: The call erlang:tuple_size + (rec_adt:rec()) contains an opaque term as 1st argument when a structured term of type + tuple() is expected diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_construct b/lib/dialyzer/test/indent_SUITE_data/results/record_construct new file mode 100644 index 0000000000..a1268de690 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_construct @@ -0,0 +1,11 @@ + +record_construct.erl:16: Record construction + #r_opa{b :: gb_sets:set(_), c :: 42, e :: 'false'} violates the declared type of field c :: + boolean() +record_construct.erl:21: Record construction + #r_rem{a :: 'gazonk'} violates the declared type of field a :: + string() +record_construct.erl:7: Record construction + #r_loc{a :: 'gazonk', b :: 42} violates the declared type of field a :: + integer() and b :: + atom() diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_creation_diffs b/lib/dialyzer/test/indent_SUITE_data/results/record_creation_diffs new file mode 100644 index 0000000000..9b5f9489db --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_creation_diffs @@ -0,0 +1,4 @@ + +record_creation_diffs.erl:11: Record construction + #bar{some_list :: {'this', 'is', 'a', 'tuple'}} violates the declared type of field some_list :: + [any()] diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_match b/lib/dialyzer/test/indent_SUITE_data/results/record_match new file mode 100644 index 0000000000..4738a4b0c9 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_match @@ -0,0 +1,4 @@ + +record_match.erl:17: Matching of pattern + {'b_literal', 'undefined'} tagged with a record name violates the declared type of + #b_local{} | #b_remote{} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_pat b/lib/dialyzer/test/indent_SUITE_data/results/record_pat new file mode 100644 index 0000000000..cf9247d5a8 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_pat @@ -0,0 +1,4 @@ + +record_pat.erl:14: Matching of pattern + {'foo', 'baz'} tagged with a record name violates the declared type of + #foo{bar :: integer()} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_send_test b/lib/dialyzer/test/indent_SUITE_data/results/record_send_test new file mode 100644 index 0000000000..51d8e1a852 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_send_test @@ -0,0 +1,6 @@ + +record_send_test.erl:30: The call erlang:'!' + (Rec1 :: #rec1{a :: 'a', b :: 'b', c :: 'c'}, + 'hello_again') will never return since it differs in the 1st argument from the success typing arguments: + (atom() | pid() | port() | {atom(), atom()}, + any()) diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_test b/lib/dialyzer/test/indent_SUITE_data/results/record_test new file mode 100644 index 0000000000..1574459578 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_test @@ -0,0 +1,6 @@ + +record_test.erl:19: Matching of pattern + {'foo', _} tagged with a record name violates the declared type of + 'foo' +record_test.erl:21: The variable _ can never match since previous clauses completely covered the type + 'foo' diff --git a/lib/dialyzer/test/indent_SUITE_data/results/record_update b/lib/dialyzer/test/indent_SUITE_data/results/record_update new file mode 100644 index 0000000000..6e4124552e --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/record_update @@ -0,0 +1,3 @@ + +record_update.erl:7: Invalid type specification for function record_update:quux/2. The success typing is + (#foo{bar :: atom()}, atom()) -> #foo{bar :: atom()} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/sample_behaviour b/lib/dialyzer/test/indent_SUITE_data/results/sample_behaviour new file mode 100644 index 0000000000..f0e41d024a --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/sample_behaviour @@ -0,0 +1,23 @@ + +sample_callback_wrong.erl:16: The inferred return type of sample_callback_2/0 + (42) has nothing in common with + atom(), which is the expected return type for the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:17: The inferred return type of sample_callback_3/0 + ('fair') has nothing in common with + 'fail' | {'ok', 1..255}, which is the expected return type for the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:18: The inferred return type of sample_callback_4/1 + ('fail') has nothing in common with + 'ok', which is the expected return type for the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:20: The inferred return type of sample_callback_5/1 + (string()) has nothing in common with + 'fail' | 'ok', which is the expected return type for the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:20: The inferred type for the 1st argument of sample_callback_5/1 ( + atom()) is not a supertype of + 1..255, which is expected type for this argument in the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:22: The inferred return type of sample_callback_6/3 + ({'okk', number()}) has nothing in common with + 'fail' | {'ok', 1..255}, which is the expected return type for the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:22: The inferred type for the 3rd argument of sample_callback_6/3 ( + atom()) is not a supertype of + string(), which is expected type for this argument in the callback of the sample_behaviour behaviour +sample_callback_wrong.erl:4: Undefined callback function sample_callback_1/0 (behaviour sample_behaviour) diff --git a/lib/dialyzer/test/indent_SUITE_data/results/simple b/lib/dialyzer/test/indent_SUITE_data/results/simple new file mode 100644 index 0000000000..bafe334405 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/simple @@ -0,0 +1,289 @@ + +exact_api.erl:17: The call exact_api:set_type + (A :: + #digraph{vtab :: 'notable', + etab :: 'notable', + ntab :: 'notable', + cyclic :: 'true'}) does not have an opaque term of type + digraph:graph() as 1st argument +exact_api.erl:23: The call digraph:delete + (G :: + #digraph{vtab :: 'notable', + etab :: 'notable', + ntab :: 'notable', + cyclic :: 'true'}) does not have an opaque term of type + digraph:graph() as 1st argument +exact_api.erl:55: The attempt to match a term of type + exact_adt:exact_adt() against the pattern + {'exact_adt'} breaks the opacity of the term +exact_api.erl:59: The call exact_adt:exact_adt_set_type2 + (A :: #exact_adt{}) does not have an opaque term of type + exact_adt:exact_adt() as 1st argument +is_rec.erl:10: The call erlang:is_record + (simple1_adt:d1(), + 'r', + 2) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:15: The call erlang:is_record + (A :: simple1_adt:d1(), + 'r', + I :: 1 | 2 | 3) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:19: Guard test is_record + (A :: simple1_adt:d1(), + 'r', + 2) breaks the opacity of its argument +is_rec.erl:23: Guard test is_record + ({simple1_adt:d1(), 1}, + 'r', + 2) breaks the opacity of its argument +is_rec.erl:41: The call erlang:is_record + (A :: simple1_adt:d1(), + R :: 'a') contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:45: The call erlang:is_record + (A :: simple1_adt:d1(), + A :: simple1_adt:d1(), + 1) contains an opaque term as 2nd argument when terms of different types are expected in these positions +is_rec.erl:49: The call erlang:is_record + (A :: simple1_adt:d1(), + any(), + 1) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:53: The call erlang:is_record + (A :: simple1_adt:d1(), + A :: simple1_adt:d1(), + any()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +is_rec.erl:57: Guard test is_record + (A :: simple1_adt:d1(), + 'r', + 2) breaks the opacity of its argument +is_rec.erl:61: The record + #r{f1 :: simple1_adt:d1()} violates the declared type for #r{} +is_rec.erl:65: The call erlang:is_record + ({simple1_adt:d1(), 1}, + 'r', + 2) contains an opaque term as 1st argument when terms of different types are expected in these positions +rec_api.erl:104: Matching of pattern + {'r2', 10} tagged with a record name violates the declared type of + #r2{f1 :: 10} +rec_api.erl:113: The attempt to match a term of type + #r3{f1 :: queue:queue(_)} against the pattern + {'r3', 'a'} breaks the opacity of + queue:queue(_) +rec_api.erl:118: Record construction + #r3{f1 :: 10} violates the declared type of field f1 :: + queue:queue(_) +rec_api.erl:123: The attempt to match a term of type + #r3{f1 :: 10} against the pattern + {'r3', 10} breaks the opacity of + queue:queue(_) +rec_api.erl:24: Record construction + #r1{f1 :: 10} violates the declared type of field f1 :: + rec_api:a() +rec_api.erl:29: Matching of pattern + {'r1', 10} tagged with a record name violates the declared type of + #r1{f1 :: 10} +rec_api.erl:33: The attempt to match a term of type + rec_adt:r1() against the pattern + {'r1', 'a'} breaks the opacity of the term +rec_api.erl:35: Invalid type specification for function rec_api:adt_t1/1. The success typing is + (#r1{f1 :: 'a'}) -> #r1{f1 :: 'a'} +rec_api.erl:40: The specification for rec_api:adt_r1/0 has an opaque subtype + rec_adt:r1() which is violated by the success typing + () -> #r1{f1 :: 'a'} +rec_api.erl:85: The attempt to match a term of type + rec_adt:f() against the record field 'f' declared to be of type + rec_api:f() breaks the opacity of the term +rec_api.erl:99: Record construction + #r2{f1 :: 10} violates the declared type of field f1 :: + rec_api:a() +simple1_api.erl:113: The test + simple1_api:d1() =:= + simple1_api:d2() can never evaluate to 'true' +simple1_api.erl:118: Guard test + simple1_api:d2() =:= + A :: simple1_api:d1() can never succeed +simple1_api.erl:142: Attempt to test for equality between a term of type + simple1_adt:o2() and a term of opaque type + simple1_adt:o1() +simple1_api.erl:148: Guard test + simple1_adt:o2() =:= + A :: simple1_adt:o1() contains opaque terms as 1st and 2nd arguments +simple1_api.erl:154: Attempt to test for inequality between a term of type + simple1_adt:o2() and a term of opaque type + simple1_adt:o1() +simple1_api.erl:160: Attempt to test for inequality between a term of type + simple1_adt:o2() and a term of opaque type + simple1_adt:o1() +simple1_api.erl:165: Attempt to test for equality between a term of type + simple1_adt:c2() and a term of opaque type + simple1_adt:c1() +simple1_api.erl:181: Guard test + A :: simple1_adt:d1() =< + B :: simple1_adt:d2() contains opaque terms as 1st and 2nd arguments +simple1_api.erl:185: Guard test + 'a' =< + B :: simple1_adt:d2() contains an opaque term as 2nd argument +simple1_api.erl:189: Guard test + A :: simple1_adt:d1() =< + 'd' contains an opaque term as 1st argument +simple1_api.erl:197: The type test is_integer + (A :: simple1_adt:d1()) breaks the opacity of the term A:: + simple1_adt:d1() +simple1_api.erl:221: Guard test + A :: simple1_api:i1() > + 3 can never succeed +simple1_api.erl:225: Guard test + A :: simple1_adt:i1() > + 3 contains an opaque term as 1st argument +simple1_api.erl:233: Guard test + A :: simple1_adt:i1() < + 3 contains an opaque term as 1st argument +simple1_api.erl:239: Guard test + A :: 1 > + 3 can never succeed +simple1_api.erl:243: Guard test + A :: 1 > + 3 can never succeed +simple1_api.erl:257: Guard test is_function + (T :: simple1_api:o1()) can never succeed +simple1_api.erl:265: Guard test is_function + (T :: simple1_adt:o1()) breaks the opacity of its argument +simple1_api.erl:269: The type test is_function + (T :: simple1_adt:o1()) breaks the opacity of the term T:: + simple1_adt:o1() +simple1_api.erl:274: Guard test is_function + (T :: simple1_api:o1(), + A :: simple1_api:i1()) can never succeed +simple1_api.erl:284: Guard test is_function + (T :: simple1_adt:o1(), + A :: simple1_adt:i1()) breaks the opacity of its argument +simple1_api.erl:289: The type test is_function + (T :: simple1_adt:o1(), + A :: simple1_adt:i1()) breaks the opacity of the term T:: + simple1_adt:o1() +simple1_api.erl:294: The call erlang:is_function + (T :: simple1_api:o1(), + A :: simple1_adt:i1()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +simple1_api.erl:300: The type test is_function + (T :: simple1_adt:o1(), + A :: simple1_api:i1()) breaks the opacity of the term T:: + simple1_adt:o1() +simple1_api.erl:306: Guard test + B :: simple1_api:b2() =:= + 'true' can never succeed +simple1_api.erl:315: Guard test + A :: simple1_api:b1() =:= + 'false' can never succeed +simple1_api.erl:319: Guard test not(and + ('true', + 'true')) can never succeed +simple1_api.erl:337: Clause guard cannot succeed. +simple1_api.erl:342: Guard test + B :: simple1_adt:b2() =:= + 'true' contains an opaque term as 1st argument +simple1_api.erl:347: Guard test + A :: simple1_adt:b1() =:= + 'true' contains an opaque term as 1st argument +simple1_api.erl:355: Invalid type specification for function simple1_api:bool_adt_t6/1. The success typing is + ('true') -> 1 +simple1_api.erl:365: Clause guard cannot succeed. +simple1_api.erl:368: Invalid type specification for function simple1_api:bool_adt_t8/2. The success typing is + (boolean(), boolean()) -> 1 +simple1_api.erl:378: Clause guard cannot succeed. +simple1_api.erl:381: Invalid type specification for function simple1_api:bool_adt_t9/2. The success typing is + ('false', 'false') -> 1 +simple1_api.erl:407: The size + simple1_adt:i1() breaks the opacity of A +simple1_api.erl:418: The attempt to match a term of type + non_neg_integer() against the variable A breaks the opacity of + simple1_adt:i1() +simple1_api.erl:425: The attempt to match a term of type + non_neg_integer() against the variable B breaks the opacity of + simple1_adt:i1() +simple1_api.erl:432: The pattern + <<_:B>> can never match the type + any() +simple1_api.erl:448: The attempt to match a term of type + non_neg_integer() against the variable Sz breaks the opacity of + simple1_adt:i1() +simple1_api.erl:460: The attempt to match a term of type + simple1_adt:bit1() against the pattern + <<_/binary>> breaks the opacity of the term +simple1_api.erl:478: The call 'foo':A + (A :: simple1_adt:a()) breaks the opacity of the term A :: + simple1_adt:a() +simple1_api.erl:486: The call A:'foo' + (A :: simple1_adt:a()) breaks the opacity of the term A :: + simple1_adt:a() +simple1_api.erl:499: The call 'foo':A + (A :: simple1_api:i()) requires that A is of type + atom() not + simple1_api:i() +simple1_api.erl:503: The call 'foo':A + (A :: simple1_adt:i()) requires that A is of type + atom() not + simple1_adt:i() +simple1_api.erl:507: The call A:'foo' + (A :: simple1_api:i()) requires that A is of type + atom() not + simple1_api:i() +simple1_api.erl:511: The call A:'foo' + (A :: simple1_adt:i()) requires that A is of type + atom() not + simple1_adt:i() +simple1_api.erl:519: Guard test + A :: simple1_adt:d2() == + B :: simple1_adt:d1() contains opaque terms as 1st and 2nd arguments +simple1_api.erl:534: Guard test + A :: simple1_adt:d1() >= + 3 contains an opaque term as 1st argument +simple1_api.erl:536: Guard test + A :: simple1_adt:d1() == + 3 contains an opaque term as 1st argument +simple1_api.erl:538: Guard test + A :: simple1_adt:d1() =:= + 3 contains an opaque term as 1st argument +simple1_api.erl:548: The call erlang:'<' + (A :: simple1_adt:d1(), + 3) contains an opaque term as 1st argument when terms of different types are expected in these positions +simple1_api.erl:558: The call erlang:'=<' + (A :: simple1_adt:d1(), + B :: simple1_adt:d2()) contains opaque terms as 1st and 2nd arguments when terms of different types are expected in these positions +simple1_api.erl:565: Guard test + {digraph:graph(), 3} > + {digraph:graph(), atom() | ets:tid()} contains an opaque term as 2nd argument +simple1_api.erl:91: The specification for simple1_api:tup/0 has an opaque subtype + simple1_adt:tuple1() which is violated by the success typing + () -> {'a', 'b'} +simple2_api.erl:100: The call lists:flatten + (A :: simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type + [any()] is expected +simple2_api.erl:116: The call lists:flatten + ({simple1_adt:tuple1()}) will never return since it differs in the 1st argument from the success typing arguments: + ([any()]) +simple2_api.erl:121: Guard test + {simple1_adt:d1(), 3} > + {simple1_adt:d1(), simple1_adt:tuple1()} contains an opaque term as 2nd argument +simple2_api.erl:125: The call erlang:tuple_to_list + (B :: simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type + tuple() is expected +simple2_api.erl:31: The call erlang:'!' + (A :: simple1_adt:d1(), + 'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:35: The call erlang:send + (A :: simple1_adt:d1(), + 'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:51: The call erlang:'<' + (A :: simple1_adt:d1(), + 3) contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:59: The call lists:keysearch + (1, + A :: simple1_adt:d1(), + []) contains an opaque term as 2nd argument when terms of different types are expected in these positions +simple2_api.erl:67: The call lists:keysearch + ('key', + 1, + A :: simple1_adt:tuple1()) contains an opaque term as 3rd argument when terms of different types are expected in these positions +simple2_api.erl:96: The call lists:keyreplace + ('a', + 1, + [{1, 2}], + A :: simple1_adt:tuple1()) contains an opaque term as 4th argument when terms of different types are expected in these positions diff --git a/lib/dialyzer/test/indent_SUITE_data/results/suppress_request b/lib/dialyzer/test/indent_SUITE_data/results/suppress_request new file mode 100644 index 0000000000..c08f1798c1 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/suppress_request @@ -0,0 +1,11 @@ + +suppress_request.erl:21: Expression produces a value of type + {'a', 'b'}, but this value is unmatched +suppress_request.erl:25: Expression produces a value of type + {'a', 'b'}, but this value is unmatched +suppress_request.erl:39: Guard test + 2 =:= + A :: fun((none()) -> no_return()) can never succeed +suppress_request.erl:7: Type specification suppress_request:test1 + ('a' | 'b') -> 'ok' is a subtype of the success typing: suppress_request:test1 + ('a' | 'b' | 'c') -> 'ok' diff --git a/lib/dialyzer/test/indent_SUITE_data/results/trec b/lib/dialyzer/test/indent_SUITE_data/results/trec new file mode 100644 index 0000000000..f19f728750 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/trec @@ -0,0 +1,10 @@ + +trec.erl:29: The call trec:mk_foo_loc + (42, + any()) will never return since it differs in the 1st argument from the success typing arguments: + ('undefined', + atom()) +trec.erl:32: Record construction violates the declared type for #foo{} since variable A cannot be of type + atom() +trec.erl:39: Record construction violates the declared type for #foo{} since variable A cannot be of type + atom() diff --git a/lib/dialyzer/test/indent_SUITE_data/results/whereis_control_flow1 b/lib/dialyzer/test/indent_SUITE_data/results/whereis_control_flow1 new file mode 100644 index 0000000000..0e733fced6 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/results/whereis_control_flow1 @@ -0,0 +1,4 @@ + +whereis_control_flow1.erl:13: The call erlang:register + (AnAtom :: atom(), + Pid :: pid()) might fail due to a possible race condition caused by its combination with the erlang:whereis(AnAtom::any()) call in whereis_control_flow1.erl on line 8 diff --git a/lib/dialyzer/test/indent_SUITE_data/src/abs.erl b/lib/dialyzer/test/indent_SUITE_data/src/abs.erl new file mode 100644 index 0000000000..0e38c3dbb7 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/abs.erl @@ -0,0 +1,78 @@ +-module(abs). + +%% OTP-12948. erlang:abs/1 bug fix. + +-export([t/0]). + +t() -> + Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0, fun erl_551/0], + _ = [catch F() || F <- Fs], + ok. + +i1() -> + A = int(), + I1 = i1(A), + true = I1 < 2, + true = I1 < 1. % can never match + +-spec i1(neg_integer()) -> non_neg_integer(). + +i1(A) when is_integer(A), A < 0 -> + abs(A). + +i2() -> + A = int(), + I2 = i2(A), + true = I2 < 1, + true = I2 < 0. % can never match + +-spec i2(non_neg_integer()) -> non_neg_integer(). + +i2(A) when is_integer(A), A >= 0 -> + abs(A). + +i3() -> + A = int(), + I3 = i3(A), + true = I3 < -1, + true = I3 < 0. % can never match + +-spec i3(integer()) -> non_neg_integer(). + +i3(A) when is_integer(A) -> + abs(A). + +i4() -> + A = int(), + I4 = i4(A), + true = I4 =:= 0 orelse I4 =:= 1, + true = I4 < 0 orelse I4 > 1. % can never match + +-spec i4(integer()) -> number(). + +i4(A) when A =:= -1; A =:= 0; A =:= 1 -> + abs(A). + +f1() -> + F1 = f1(float()), + math:sqrt(F1). + +f1(A) -> + abs(A). + +erl_551() -> + accept(9), + accept(-3). + +accept(Number) when abs(Number) >= 8 -> first; +accept(_Number) -> second. + +-spec int() -> integer(). + +int() -> + foo:bar(). + +-spec float() -> float(). + +float() -> + math:sqrt(1.0). diff --git a/lib/dialyzer/test/indent_SUITE_data/src/app_call.erl b/lib/dialyzer/test/indent_SUITE_data/src/app_call.erl new file mode 100644 index 0000000000..54d178d29a --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/app_call.erl @@ -0,0 +1,17 @@ +-module(app_call). +-export([test/1]). + +test(m) -> + M = get_mod(), + M:foo(); +test(f) -> + F = get_fun(), + mod:F(); +test(_) -> + ok. + +get_mod() -> + 42. + +get_fun() -> + {gazonk, []}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/blame_contract_range.erl b/lib/dialyzer/test/indent_SUITE_data/src/blame_contract_range.erl new file mode 100644 index 0000000000..efd3332b44 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/blame_contract_range.erl @@ -0,0 +1,16 @@ +%%----------------------------------------------------------------------- +%% A test where the contract is wrongly specified by the programmer; +%% however, this is found only by refinement. +%% Dialyzer in R14B01 and prior gave a confusing (if not bogus) warning +%% for this case. Corrected in R14B02. +%%----------------------------------------------------------------------- +-module(blame_contract_range). + +-export([foo/0]). + +foo() -> + bar(b). + +-spec bar(atom()) -> a. +bar(a) -> a; +bar(b) -> b. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/bs_fail_constr.erl b/lib/dialyzer/test/indent_SUITE_data/src/bs_fail_constr.erl new file mode 100644 index 0000000000..8c1f8c009a --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/bs_fail_constr.erl @@ -0,0 +1,15 @@ +-module(bs_fail_constr). + +-export([w1/1, w2/1, w3/1, w4/1]). + +w1(V) when is_float(V) -> + <<V/integer>>. + +w2(V) when is_atom(V) -> + <<V/binary>>. + +w3(S) when is_integer(S), S < 0 -> + <<42:S/integer>>. + +w4(V) when is_float(V) -> + <<V/utf32>>. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_behaviour.erl b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_behaviour.erl new file mode 100644 index 0000000000..c4e5203448 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_behaviour.erl @@ -0,0 +1,11 @@ +-module(my_behaviour). + +-callback callback_init(Parent :: pid()) -> {'ok', State::term()}. + +-callback callback_cast(State::term(), From::pid(), Msg::term()) -> + {'noreply', NewState::term()}. + +-callback callback_call(State::term(), From::pid(), Msg::term()) -> + {'reply', NewState::term(), Reply::term()}. + +-callback callback_exit(State::term()) -> 'ok'. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl new file mode 100644 index 0000000000..041b4ac56c --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl @@ -0,0 +1,59 @@ +-module(my_callbacks_correct). + +-export([ + callback_init/1 + , callback_call/3 + , callback_cast/3 + , callback_exit/1 + ]). + +-record(state, { + parent :: pid(), + status = init :: 'init' | 'open' | 'closed', + subscribe = [] :: list({pid(), integer()}), + counter = 1 :: integer() + }). + +-type state() :: #state{}. + +-type cast_message() :: 'open' | 'closed'. + +-type call_message() :: 'subscribe' | 'unsubscribe'. +-type call_reply() :: 'accepted' | 'rejected'. + +-spec callback_init(Parent::pid()) -> {'ok', state()}. + +callback_init(Parent) -> + {ok, #state{parent = Parent}}. + +-spec callback_cast(state(), pid(), cast_message()) -> {'noreply', state()}. + +callback_cast(#state{parent = Pid} = State, Pid, Message) + when Message =:= 'open'; Message =:= 'close' -> + {noreply, State#state{status = Message}}; +callback_cast(State, _Pid, _Message) -> + {noreply, State}. + +-spec callback_call(state(), pid(), call_message()) -> + {'reply', state(), call_reply()}. + +callback_call(#state{status = open, subscribe = Subscribers} = State, + Pid, Message) + when Message =:= 'subscribe'; + Message =:= 'unsubscribe' -> + NewState = + case Message of + subscribe -> + N = State#state.counter, + State#state{subscribe = [{Pid, N}|Subscribers], counter = N+1}; + unsubscribe -> + State#state{subscribe = lists:keydelete(Pid, 1, Subscribers)} + end, + {reply, NewState, accepted}; +callback_call(State, _Pid, _Message) -> + {reply, State, rejected}. + +-spec callback_exit(state()) -> 'ok'. + +callback_exit(_State) -> + ok. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl new file mode 100644 index 0000000000..0459622dc1 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl @@ -0,0 +1,61 @@ +-module(my_callbacks_wrong). + +-export([ + callback_init/1 + , callback_call/3 + , callback_cast/3 + , callback_exit/1 + ]). + +-behaviour(my_behaviour). + +-record(state, { + parent :: pid(), + status = init :: 'init' | 'open' | 'closed', + subscribe = [] :: list({pid(), integer()}), + counter = 1 :: integer() + }). + +-type state() :: #state{}. + +-type cast_message() :: 'open' | 'closed'. + +-type call_message() :: 'subscribe' | 'unsubscribe'. +-type call_reply() :: 'accepted' | 'rejected'. + +-spec callback_init(Parent::pid()) -> state(). %% Wrong return spec + +callback_init(Parent) -> #state{parent = Parent}. %% Wrong return + +-spec callback_cast(state(), pid() | atom(), cast_message()) -> + {'noreply' | 'reply', state()}. %% More generic spec + +callback_cast(#state{parent = Pid} = State, Pid, Message) + when Message =:= 'open'; Message =:= 'close' -> + {noreply, State#state{status = Message}}; +callback_cast(State, _Pid, _Message) -> + {noreply, State}. + +-spec callback_call(state(), atom(), call_message()) -> %% Wrong arg spec + {'reply', state(), call_reply()}. + +callback_call(#state{status = open, subscribe = Subscribers} = State, + Pid, Message) + when Message =:= 'subscribe'; + Message =:= 'unsubscribe' -> + NewState = + case Message of + subscribe -> + N = State#state.counter, + State#state{subscribe = [{Pid, N}|Subscribers], counter = N+1}; + unsubscribe -> + State#state{subscribe = lists:keydelete(Pid, 1, Subscribers)} + end, + {reply, NewState, accepted}; +callback_call(State, _Pid, _Message) -> + {reply, State, rejected}. + +-spec callback_exit(state()) -> ok. + +callback_exit(_State) -> + ok. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/contract3.erl b/lib/dialyzer/test/indent_SUITE_data/src/contract3.erl new file mode 100644 index 0000000000..a6ce91882e --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/contract3.erl @@ -0,0 +1,40 @@ +%%%------------------------------------------------------------------- +%%% File : contract3.erl +%%% Author : Tobias Lindahl <[email protected]> +%%% Description : Check overloaded domains +%%% +%%% Created : 2 Nov 2007 by Tobias Lindahl <[email protected]> +%%%------------------------------------------------------------------- +-module(contract3). + +-export([t/3]). + +t(X, Y, Z) -> + t1(X), + t2(X, Y), + t3(X, Y, Z). + +-spec t1(atom()|integer()) -> integer(); + (atom()|list()) -> atom(). + +t1(X) -> + f(X). + +-spec t2(atom(), integer()) -> integer(); + (atom(), list()) -> atom(). + +t2(X, Y) -> + g(X, Y). + +-spec t3(atom(), integer(), list()) -> integer(); + (X, integer(), list()) -> X. + +t3(X, Y, Z) -> + X. + +%% dummy functions below + +f(X) -> X. + +g(X, Y) when is_atom(X), is_integer(Y) -> Y; +g(X, Y) when is_atom(X), is_list(Y) -> X. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/contracts_with_subtypes.erl b/lib/dialyzer/test/indent_SUITE_data/src/contracts_with_subtypes.erl new file mode 100644 index 0000000000..dbabd904c2 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/contracts_with_subtypes.erl @@ -0,0 +1,300 @@ +-module(contracts_with_subtypes). + +-compile(export_all). + +%=============================================================================== + +-spec extract() -> 'ok'. + +extract() -> + case dz_extract() of + {ok, Val} -> Val; + error -> exit(boom) + end. + +-spec dz_extract() -> RetValue when + FileList :: something, + RetValue :: {ok, FileList} | error. + +dz_extract() -> get(foo). + +%------------------------------------------------------------------------------- + +-spec extract2() -> 'ok'. + +extract2() -> + case dz_extract2() of + {ok, Val} -> Val; + error -> exit(boom) + end. + +-spec dz_extract2() -> RetValue when + RetValue :: {ok, FileList} | error, + FileList :: something. + +dz_extract2() -> get(foo). + +%=============================================================================== + +-spec foo1(Arg1) -> Res when + Arg1 :: atom(), + Res :: atom(). + +foo1(X) -> X. + +-spec foo2(Arg1) -> Res when + Arg1 :: Arg2, + Arg2 :: atom(), + Res :: atom(). + +foo2(X) -> X. + +-spec foo3(Arg1) -> Res when + Arg2 :: atom(), + Arg1 :: Arg2, + Res :: atom(). + +foo3(X) -> X. + +-spec foo4(Type) -> Type when is_subtype(Type, atom()). + +foo4(X) -> X. + +-spec foo5(Type :: atom()) -> Type :: atom(). + +foo5(X) -> X. + +-spec foo6(Type) -> Type when Type :: atom(). + +foo6(X) -> X. + +-spec foo7(Type) -> Type. + +foo7(X) -> X. + +%------------------------------------------------------------------------------- + +bar(1) -> foo1(5); +bar(2) -> foo2(5); +bar(3) -> foo3(5); +bar(4) -> foo4(5); +bar(5) -> foo5(5); +bar(6) -> foo6(5); +bar(7) -> foo7(5). + +wrong_foo6() -> + b = foo6(a). + +%=============================================================================== + +-spec rec_arg(Arg) -> ok when + Arg :: {a, A} | {b, B}, + A :: a | {b, B}, + B :: b | {a, A}. + +rec_arg(X) -> get(X). + +c(aa) -> rec_arg({a, a}); +c(bb) -> rec_arg({b, b}); +c(abb) -> rec_arg({a, {b, b}}); +c(baa) -> rec_arg({b, {a, a}}); +c(abaa) -> rec_arg({a, {b, {a, a}}}); +c(babb) -> rec_arg({b, {a, {b, b}}}); +c(ababb) -> rec_arg({a, {b, {a, {b, b}}}}); +c(babaa) -> rec_arg({b, {a, {b, {a, a}}}}). + +w(ab) -> rec_arg({a, b}); % breaks the contract +w(ba) -> rec_arg({b, a}); % breaks the contract +w(aba) -> rec_arg({a, {b, a}}); % no longer breaks the contract +w(bab) -> rec_arg({b, {a, b}}); % breaks the contract +w(abab) -> rec_arg({a, {b, {a, b}}}); % no longer breaks the contract +w(baba) -> rec_arg({b, {a, {b, a}}}); % no longer breaks the contract +w(ababa) -> rec_arg({a, {b, {a, {b, a}}}}); +w(babab) -> rec_arg({b, {a, {b, {a, b}}}}). + +%% For comparison: the same thing with types + +-type ab() :: {a, a()} | {b, b()}. +-type a() :: a | {b, b()}. +-type b() :: b | {a, a()}. + +-spec rec2(Arg) -> ok when + Arg :: ab(). + +rec2(X) -> get(X). + +d(aa) -> rec2({a, a}); +d(bb) -> rec2({b, b}); +d(abb) -> rec2({a, {b, b}}); +d(baa) -> rec2({b, {a, a}}); +d(abaa) -> rec2({a, {b, {a, a}}}); +d(babb) -> rec2({b, {a, {b, b}}}); +d(ababb) -> rec2({a, {b, {a, {b, b}}}}); +d(babaa) -> rec2({b, {a, {b, {a, a}}}}). + +q(ab) -> rec2({a, b}); % breaks the contract +q(ba) -> rec2({b, a}); % breaks the contract +q(aba) -> rec2({a, {b, a}}); % breaks the contract +q(bab) -> rec2({b, {a, b}}); % breaks the contract +q(abab) -> rec2({a, {b, {a, b}}}); % breaks the contract +q(baba) -> rec2({b, {a, {b, a}}}); % breaks the contract +q(ababa) -> rec2({a, {b, {a, {b, a}}}}); % breaks the contract +q(babab) -> rec2({b, {a, {b, {a, b}}}}); % breaks the contract +q(ababab) -> rec2({a, {b, {a, {b, {a, b}}}}}); +q(bababa) -> rec2({b, {a, {b, {a, {b, a}}}}}); +q(abababa) -> rec2({a, {b, {a, {b, {a, {b, a}}}}}}); +q(bababab) -> rec2({b, {a, {b, {a, {b, {a, b}}}}}}). + +%=============================================================================== + +-type dublo(X) :: {X, X}. + +-type weird(X,Y) :: {X, Y, X, X}. + +-spec forfun(dublo(Var)) -> ok when Var :: atom(). + +forfun(_) -> ok. + +-spec forfun2(weird(Var, Var)) -> ok when Var :: atom(). + +forfun2(_) -> ok. + +%=============================================================================== + +-spec shallow(X) -> {ok, X} | {ok, X, file:filename()} | err1 | err2. + +shallow(X) -> get(X). + +st(X) when is_atom(X) -> + case shallow(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + {ok, X, Res} -> + case Res of + 1 -> bad; + _Other -> ok + end; + alpha -> bad; + {ok, 42} -> ok; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-spec deep(X) -> Ret when + Ret :: {ok, X} | Err, + Err :: err1 | err2. + +deep(X) -> get(X). + +dt(X) when is_atom(X) -> + case deep(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + alpha -> bad; + {ok, 42} -> ok; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-type local_errors() :: err1 | err2. + +-spec deep2(X) -> Ret when + Ret :: {ok, X} | Err, + Err :: local_errors(). + +deep2(X) -> get(X). + +dt2(X) when is_atom(X) -> + case deep2(X) of + err1 -> ok; + err2 -> ok; + {ok, X} -> ok; + alpha -> bad; + {ok, 42} -> ok; + 42 -> bad + end. + +%------------------------------------------------------------------------------- + +-spec deep3(X) -> Ret when + Ret :: {ok, X, file:filename()} | Err, + Err :: local_errors(). + +deep3(X) -> get(X). + +dt3(X) when is_atom(X) -> + case deep3(X) of + err1 -> ok; + err2 -> ok; + {ok, X, Res} -> + case Res of + 1 -> bad; + _Other -> ok + end; + {ok, X} -> bad; + alpha -> bad; + {ok, 42} -> bad; + 42 -> bad + end. + +%=============================================================================== + +-spec flat_ets_new(Name, Options) -> atom() when + Name :: atom(), + Options :: [Option], + Option :: set + | ordered_set + | bag + | duplicate_bag + | public + | protected + | private + | named_table + | {keypos, integer()} + | {heir, pid(), term()} + | {heir, none} + | {write_concurrency, boolean()} + | {read_concurrency, boolean()} + | compressed. + +flat_ets_new(Name, Options) -> + get({Name, Options}). + +flat_ets_new_t() -> + flat_ets_new(12,[]), + flat_ets_new({a,b},[]), + flat_ets_new(name,[foo]), + flat_ets_new(name,{bag}), + flat_ets_new(name,bag), + ok. + +-type access() :: public | protected | private. +-type type() :: set | ordered_set | bag | duplicate_bag. + +-spec factored_ets_new(Name, Options) -> atom() when + Name :: atom(), + Options :: [Option], + Option :: Type | Access | named_table | {keypos,Pos} + | {heir, Pid :: pid(), HeirData} | {heir, none} | Tweaks, + Type :: type(), + Access :: access(), + Tweaks :: {write_concurrency, boolean()} + | {read_concurrency, boolean()} + | compressed, + Pos :: pos_integer(), + HeirData :: term(). + +factored_ets_new(Name, Options) -> + get({Name, Options}). + +factored_ets_new_t() -> + factored_ets_new(12,[]), + factored_ets_new({a,b},[]), + factored_ets_new(name,[foo]), + factored_ets_new(name,{bag}), + factored_ets_new(name,bag), + ok. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/dict_use.erl b/lib/dialyzer/test/indent_SUITE_data/src/dict_use.erl new file mode 100644 index 0000000000..2527f166f2 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/dict_use.erl @@ -0,0 +1,82 @@ +-module(dict_use). + +-export([ok1/0, ok2/0, ok3/0, ok4/0, ok5/0, ok6/0]). +-export([middle/0]). +-export([w1/0, w2/0, w3/0, w4/1, w5/0, w6/0, w7/0, w8/1, w9/0]). + +-define(DICT, dict). + +%%--------------------------------------------------------------------- +%% Cases that are OK +%%--------------------------------------------------------------------- + +ok1() -> + dict:new(). + +ok2() -> + case dict:new() of X -> X end. + +ok3() -> + Dict1 = dict:new(), + Dict2 = dict:new(), + Dict1 =:= Dict2. + +ok4() -> + dict:fetch(foo, dict:new()). + +ok5() -> % this is OK since some_mod:new/0 might be returning a dict:dict() + dict:fetch(foo, some_mod:new()). + +ok6() -> + dict:store(42, elli, dict:new()). + +middle() -> + {w1(), w2()}. + +%%--------------------------------------------------------------------- +%% Cases that are problematic w.r.t. opacity of types +%%--------------------------------------------------------------------- + +w1() -> + gazonk = dict:new(). + +w2() -> + case dict:new() of + [] -> nil; + 42 -> weird + end. + +w3() -> + try dict:new() of + [] -> nil; + 42 -> weird + catch + _:_ -> exception + end. + +w4(Dict) when is_list(Dict) -> + Dict =:= dict:new(); +w4(Dict) when is_atom(Dict) -> + Dict =/= dict:new(). + +w5() -> + case dict:new() of + D when length(D) =/= 42 -> weird; + D when is_atom(D) -> weirder; + D when is_list(D) -> gazonk + end. + +w6() -> + is_list(dict:new()). + +w7() -> + dict:fetch(foo, [1,2,3]). + +w8(Fun) -> + dict:merge(Fun, 42, [1,2]). + +w9() -> + dict:store(42, elli, + {dict,0,16,16,8,80,48, + {[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}, + {{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}). diff --git a/lib/dialyzer/test/indent_SUITE_data/src/fun_app.erl b/lib/dialyzer/test/indent_SUITE_data/src/fun_app.erl new file mode 100644 index 0000000000..20b6138d26 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/fun_app.erl @@ -0,0 +1,41 @@ +%% This is taken from the code of distel. + +-module(fun_app). +-export([html_index/2]). % , lines/3, curry/2]). + +html_index(file,Dir) -> + fold_file(curry(fun lines/3,Dir),[],filename:join([Dir,"doc","man_index.html"])). + +fold_file(Fun,Acc0,File) -> + {ok, FD} = file:open(File, [read]), + Acc = fold_file_lines(FD,Fun,Acc0), + file:close(FD), + Acc. + +fold_file_lines(FD,Fun,Acc) -> + case io:get_line(FD, "") of + eof -> Acc; + Line -> fold_file_lines(FD,Fun,Fun(trim_nl(Line),Acc)) + end. + +trim_nl(Str) -> lists:reverse(tl(lists:reverse(Str))). + +lines(Line,_,Dir) -> + case string:tokens(Line, "<> \"") of + ["TD", "A", "HREF=", "../"++Href, M|_] -> + case filename:basename(Href, ".html") of + "index" -> ok; + M -> e_set({file,M}, filename:join([Dir,Href])) + end; + _ -> ok + end. + +e_set(Key,Val) -> ets:insert(?MODULE, {Key,Val}). + +curry(F, Arg) -> + case erlang:fun_info(F,arity) of + {_,1} -> fun() -> F(Arg) end; + {_,2} -> fun(A) -> F(A,Arg) end; + {_,3} -> fun(A,B) -> F(A,B,Arg) end; + {_,4} -> fun(A,B,C) -> F(A,B,C,Arg) end + end. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/fun_app_args.erl b/lib/dialyzer/test/indent_SUITE_data/src/fun_app_args.erl new file mode 100644 index 0000000000..b4409bc550 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/fun_app_args.erl @@ -0,0 +1,12 @@ +-module(fun_app_args). + +-export([t/1]). + +-type ft() :: fun((a, []) -> any()). + +-record(r, { + h = c :: c | ft() +}). + +t(#r{h = H}) -> + fun(_) -> (H)(b, []) end. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/guard_update.erl b/lib/dialyzer/test/indent_SUITE_data/src/guard_update.erl new file mode 100644 index 0000000000..19d0089401 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/guard_update.erl @@ -0,0 +1,18 @@ +-module(guard_update). + +-export([t/0, t2/0]). + +t() -> + f(#{a=>2}). %% Illegal + +f(M) + when M#{b := 7} =/= q + -> ok. + +t2() -> + f2(#{a=>2}). %% Legal! + +f2(M) + when M#{b := 7} =/= q; + M =/= p + -> ok. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/guard_warnings.erl b/lib/dialyzer/test/indent_SUITE_data/src/guard_warnings.erl new file mode 100644 index 0000000000..6ab13eef9a --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/guard_warnings.erl @@ -0,0 +1,118 @@ +%% +%% A couple of tests for booleans in guards. +%% Tests with suffix w have incomplete results due to weak dataflow. +%% Tests with suffix ww have incomplete results due to weak dialyzer. +%% Tests with suffix x should not give warnings. +%% + +-module(and_bug). + +-compile(export_all). + +test1(X) when X and not X -> never. + +test2(X) when not X and X -> never. + +test3(X) when (X and not X) =:= true -> never. + +test4(X) when (not X and X) =:= true -> never. + +test5(X) when (X and not X) == true -> never. + +test6(X) when (not X and X) == true -> never. + +test7_w(X) when not (X or not X) -> never. + +test8_w(X) when not (not X or X) -> never. + +test9(X) when (X or not X) =:= false -> never. + +test10(X) when (not X or X) =:= false -> never. + +test11(X) when (X or not X) == false -> never. + +test12(X) when (not X or X) == false -> never. + +test13(X) when X and false -> never. + +test14(X) when false and X -> never. + +test15(X) when (X and false) =:= true -> never. + +test16(X) when (false and X) =:= true -> never. + +test17(X) when (X and false) == true -> never. + +test18(X) when (false and X) == true -> never. + +test19(X) when not (true or X) -> never. + +test20(X) when not (X or true) -> never. + +test21(X) when (true or X) =:= false -> never. + +test22(X) when (X or true) =:= false -> never. + +test23(X) when (true or X) == false -> never. + +test24(X) when (X or true) == false -> never. + +test25(X) when (false and X) -> never. + +test26(X) when (X and false) -> never. + +test27(X) when (false and X) =:= true -> never. + +test28(X) when (X and false) =:= true -> never. + +test29(X) when (false and X) == true -> never. + +test30(X) when (X and false) == true -> never. + +test31() when false and false -> never. + +test32() when (false and false) =:= true -> never. + +test33() when not (true and true) =:= true -> never. + +test34() when (false and false) == true -> never. + +test35() when not (true and true) == true -> never. + +test36() when false or false -> never. + +test37() when (false or false) =:= true -> never. + +test38() when not (false or false) =:= false -> never. + +test39() when (false or false) == true -> never. + +test40() when not (false or false) == false -> never. + +test41() when true =:= false -> never. + +test42() when true == false -> never. + +test43() when not (true =:= true) -> never. + +test44() when not (true == true) -> never. + +test45() when not (not (not (not (not (not (not true)))))) -> never. + +test46(X) when (X =:= true) and (X =:= false) -> never. + +test47(X) when (X == true) and (X == false) -> never. + +test48(X) when is_boolean(X) and (X =:= true) and (X =/= true) -> never. + +test49_x(X) when not (X or X) -> maybe. + +test50_x(X) when not (X and X) -> maybe. + +test51_x(X) when not (not X) -> maybe. + +test52_w(X) when is_boolean(X) and (X =/= true) and (X =:= true) -> never. + +test53_ww(X) when is_boolean(X) and (X =/= true) and (X =/= false) -> never. + +test54_w(X) when is_boolean(X) and not ((X =:= true) or (X =:= false)) -> never. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/map_galore.erl b/lib/dialyzer/test/indent_SUITE_data/src/map_galore.erl new file mode 100644 index 0000000000..99eb73a5f6 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/map_galore.erl @@ -0,0 +1,2800 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(map_galore). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, t_build_and_match_literals_large/1, + t_update_literals/1, t_update_literals_large/1, + t_match_and_update_literals/1, t_match_and_update_literals_large/1, + t_update_map_expressions/1, + t_update_assoc/1, t_update_assoc_large/1, + t_update_exact/1, t_update_exact_large/1, + t_guard_bifs/1, + t_guard_sequence/1, t_guard_sequence_large/1, + t_guard_update/1, t_guard_update_large/1, + t_guard_receive/1, t_guard_receive_large/1, + t_guard_fun/1, + t_update_deep/1, + t_list_comprehension/1, + t_map_sort_literals/1, + t_map_equal/1, + t_map_compare/1, + t_map_size/1, + t_is_map/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + + %% non specific BIF related + t_bif_build_and_check/1, + t_bif_merge_and_check/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_erts_internal_order/1, + t_erts_internal_hash/1, + t_pdict/1, + t_ets/1, + t_dets/1, + t_tracing/1, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1 + ]). + +-include_lib("stdlib/include/ms_transform.hrl"). + +-define(CHECK(Cond,Term), + case (catch (Cond)) of + true -> true; + _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]), + exit(Term) + end). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, t_build_and_match_literals_large, + t_update_literals, t_update_literals_large, + t_match_and_update_literals, t_match_and_update_literals_large, + t_update_map_expressions, + t_update_assoc, t_update_assoc_large, + t_update_exact, t_update_exact_large, + t_guard_bifs, + t_guard_sequence, t_guard_sequence_large, + t_guard_update, t_guard_update_large, + t_guard_receive, t_guard_receive_large, + t_guard_fun, t_list_comprehension, + t_update_deep, + t_map_equal, t_map_compare, + t_map_sort_literals, + + %% Specific Map BIFs + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_map_size, t_is_map, + + %% non specific BIF related + t_bif_build_and_check, + t_bif_merge_and_check, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_erts_internal_order, + t_erts_internal_hash, + t_pdict, + t_ets, + t_tracing, + + %% instruction-level tests + t_has_map_fields, + y_regs + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = #{}, + #{1:=a} = #{1=>a}, + #{1:=a,2:=b} = #{1=>a,2=>b}, + #{1:=a,2:=b,3:="c"} = #{1=>a,2=>b,3=>"c"}, + #{1:=a,2:=b,3:="c","4":="d"} = #{1=>a,2=>b,3=>"c","4"=>"d"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}, + + #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} = + #{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}, + + #{<<"hi all">> := 1} = #{<<"hi",32,"all">> => 1}, + + #{a:=X,a:=X=3,b:=4} = #{a=>3,b=>4}, % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + #{ b=>first, a=>#{ b=>#{c => third, b=> second}}}, + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + + %% error case + %V = 32, + %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = #{<<"hi",V,"all">> => 1})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = {a,b,c})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{y=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{x=>"three"})), + ok. + +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0, + + 60 = map_size(M0), + 60 = maps:size(M0), + + % with repeating + M1 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10", + 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11", + 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + + 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13", + 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14", + + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + 60 = map_size(M1), + 60 = maps:size(M1), + + % with floats + + M2 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + 90 = map_size(M2), + 90 = maps:size(M2), + + % with bignums + M3 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + 36893488147419103232=>big1, 73786976294838206464=>big2, + 147573952589676412928=>big3, 18446744073709551616=>big4, + 4294967296=>big5, 8589934592=>big6, + 4294967295=>big7, 67108863=>big8 + }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + 98 = map_size(M3), + 98 = maps:size(M3), + + %% with maps + + M4 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M4, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4, + + + #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15", + #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := V4, + #{ third => small, map => key } := "small map key 3", + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4, + + a5 = V1, + "c5" = V2, + "e5" = V3, + "small map key 2" = V4, + "large map key 1" = V5, + + 95 = map_size(M4), + 95 = maps:size(M4), + + % call for value + + M5 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M5, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5, + + 95 = map_size(M5), + 95 = maps:size(M5), + + %% remember + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + ok. + + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(#{}), + 1 = map_size(#{a=>1}), + 1 = map_size(#{a=>"wat"}), + 2 = map_size(#{a=>1, b=>2}), + 3 = map_size(#{a=>1, b=>2, b=>"3","33"=><<"n">>}), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)], + ok = build_and_check_size(Ks,0,#{}), + + %% try deep collisions + %% statistically we get another subtree at 50k -> 100k elements + %% Try to be nice and don't use too much memory in the testcase, + + N = 500000, + Is = lists:seq(1,N), + N = map_size(maps:from_list([{I,I}||I<-Is])), + N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])), + N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])), + N = map_size(maps:from_list([{float(I),I}||I<-Is])), + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), + ok. + +build_and_check_size([K|Ks],N,M0) -> + N = map_size(M0), + M1 = M0#{ K => K }, + build_and_check_size(Ks,N + 1,M1); +build_and_check_size([],N,M) -> + N = map_size(M), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +t_is_map(Config) when is_list(Config) -> + true = is_map(#{}), + true = is_map(#{a=>1}), + false = is_map({a,b}), + false = is_map(x), + if is_map(#{}) -> ok end, + if is_map(#{b=>1}) -> ok end, + if not is_map([1,2,3]) -> ok end, + if not is_map(x) -> ok end, + ok. + +% test map updates without matching +t_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, + #{ "one" => small, map => key } => "small map key 1" }, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = #{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = Map#{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0, + #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + #{ a := 1 } = M#{a => 1}, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + Ks = lists:seq($a,$z), + #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } = + (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 }, + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch (T)#{a:=42,b=>2}) + end), + ok. + +t_update_assoc(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + ok. + + +t_update_assoc_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1, + #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} = + M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{13.0=>new}, + #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2, + M2 = M0#{13.0:=wrong,13.0=>new}, + + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = #{ 1 => val}, + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = #{}, + {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]}, + #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c], + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1, + + M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]}, + + M2 = M0#{13.0:=new}, + #{10:=a0,20:=b0,13.0:=new} = M2, + M2 = M0#{13.0=>wrong,13.0:=new}, + + %% Errors cases. + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_deep(Config) when is_list(Config) -> + N = 250000, + M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]), + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + + M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + + M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + + M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3, + #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3, + ok. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + ok. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = #{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = #{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = #{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = #{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = #{a=>kk, b=>other, c=>sc2}), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = M0#{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = M0#{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = M0#{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = M0#{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = M0#{a=>kk, b=>other, c=>sc2}), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. + + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + ok. + +t_guard_update_large(Config) when is_list(Config) -> + M0 = #{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 70.0=>fa0,80.0=>fb0,90.0=>"fc0", + 71.0=>fa1,81.0=>fb1,91.0=>"fc1", + 72.0=>fa2,82.0=>fb2,92.0=>"fc2", + 73.0=>fa3,83.0=>fb3,93.0=>"fc3", + 74.0=>fa4,84.0=>fb4,94.0=>"fc4", + + 75.0=>fa5,85.0=>fb5,95.0=>"fc5", + 76.0=>fa6,86.0=>fb6,96.0=>"fc6", + 77.0=>fa7,87.0=>fb7,97.0=>"fc7", + 78.0=>fa8,88.0=>fb8,98.0=>"fc8", + 79.0=>fa9,89.0=>fb9,99.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + error = map_guard_update(M0#{},M0#{}), + first = map_guard_update(M0#{},M0#{x=>first}), + second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}), + ok. + + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +-define(t_guard_receive_large_procs, 1500). + +t_guard_receive_large(Config) when is_list(Config) -> + M = lists:foldl(fun(_,#{procs := Ps } = M) -> + M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }} + end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)), + lists:foreach(fun(Pid) -> + Pid ! {self(), hello} + end, maps:keys(maps:get(procs,M))), + ok = guard_receive_large_loop(M), + ok. + +guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) -> + ok; +guard_receive_large_loop(M) -> + receive + #{pid := Pid, msg := hello} -> + case M of + #{done := Count, procs := #{Pid := 150}} -> + Pid ! {self(), done}, + guard_receive_large_loop(M#{done := Count + 1}); + #{procs := #{Pid := Count} = Ps} -> + Pid ! {self(), hello}, + guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}}) + end + end. + +grecv_loop() -> + receive + {_, done} -> + ok; + {Pid, hello} -> + Pid ! #{pid=>self(), msg=>hello}, + grecv_loop() + end. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + + Ks = lists:seq($a,$z), + Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks], + [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms, + [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms), + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), + ok. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < #{ a => 1, b => 1, c => 1}, + true = #{ b => 1, a => 1} < #{ c => 1, a => 1, b => 1}, + false = #{ c => 1, b => 1, a => 1} < #{ c => 1, a => 1}, + + %% key order + true = #{ a => 1 } < #{ b => 1}, + false = #{ b => 1 } < #{ a => 1}, + true = #{ a => 1, b => 1, c => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ b => 1, c => 1, d => 1 } > #{ a => 1, b => 1, c => 1}, + true = #{ c => 1, b => 1, a => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ "a" => 1 } < #{ <<"a">> => 1}, + false = #{ <<"a">> => 1 } < #{ "a" => 1}, + true = #{ 1 => 1 } < #{ 1.0 => 1}, + false = #{ 1.0 => 1 } < #{ 1 => 1}, + + %% value order + true = #{ a => 1 } < #{ a => 2}, + false = #{ a => 2 } < #{ a => 1}, + false = #{ a => 2, b => 1 } < #{ a => 1, b => 3}, + true = #{ a => 1, b => 1 } < #{ a => 1, b => 3}, + false = #{ a => 1 } < #{ a => 1.0}, + false = #{ a => 1.0 } < #{ a => 1}, + + true = #{ "a" => "hi", b => 134 } == #{ b => 134,"a" => "hi"}, + + %% large maps + + M = maps:from_list([{I,I}||I <- lists:seq(1,500)]), + + %% size order + true = M#{ a => 1, b => 2} < M#{ a => 1, b => 1, c => 1}, + true = M#{ b => 1, a => 1} < M#{ c => 1, a => 1, b => 1}, + false = M#{ c => 1, b => 1, a => 1} < M#{ c => 1, a => 1}, + + %% key order + true = M#{ a => 1 } < M#{ b => 1}, + false = M#{ b => 1 } < M#{ a => 1}, + true = M#{ a => 1, b => 1, c => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ b => 1, c => 1, d => 1 } > M#{ a => 1, b => 1, c => 1}, + true = M#{ c => 1, b => 1, a => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ "a" => 1 } < M#{ <<"a">> => 1}, + false = M#{ <<"a">> => 1 } < #{ "a" => 1}, + true = M#{ 1 => 1 } < maps:remove(1,M#{ 1.0 => 1}), + false = M#{ 1.0 => 1 } < M#{ 1 => 1}, + + %% value order + true = M#{ a => 1 } < M#{ a => 2}, + false = M#{ a => 2 } < M#{ a => 1}, + false = M#{ a => 2, b => 1 } < M#{ a => 1, b => 3}, + true = M#{ a => 1, b => 1 } < M#{ a => 1, b => 3}, + false = M#{ a => 1 } < M#{ a => 1.0}, + false = M#{ a => 1.0 } < M#{ a => 1}, + + true = M#{ "a" => "hi", b => 134 } == M#{ b => 134,"a" => "hi"}, + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + ok. + +t_map_equal(Config) when is_list(Config) -> + true = #{} =:= #{}, + false = #{} =:= #{a=>1}, + false = #{a=>1} =:= #{}, + true = #{ "a" => "hi", b => 134 } =:= #{ b => 134,"a" => "hi"}, + + false = #{ a => 1 } =:= #{ a => 2}, + false = #{ a => 2 } =:= #{ a => 1}, + false = #{ a => 2, b => 1 } =:= #{ a => 1, b => 3}, + false = #{ a => 1, b => 1 } =:= #{ a => 1, b => 3}, + + true = #{ a => 1 } =:= #{ a => 1}, + true = #{ "a" => 2 } =:= #{ "a" => 2}, + true = #{ "a" => 2, b => 3 } =:= #{ "a" => 2, b => 3}, + true = #{ a => 1, b => 3, c => <<"wat">> } =:= #{ a => 1, b => 3, c=><<"wat">>}, + ok. + + +t_map_compare(Config) when is_list(Config) -> + Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, + io:format("seed = ~p\n", [Seed]), + random:seed(Seed), + repeat(100, fun(_) -> float_int_compare() end, []), + repeat(100, fun(_) -> recursive_compare() end, []), + ok. + +float_int_compare() -> + Terms = numeric_keys(3), + %%io:format("Keys to use: ~p\n", [Terms]), + Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms), + lists:foreach(fun(Size) -> + MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end, + repeat(100, fun do_compare/1, [MapGen, MapGen]) + end, + lists:seq(1,length(Terms))), + ok. + +numeric_keys(N) -> + lists:foldl(fun(_,Acc) -> + Int = random:uniform(N*4) - N*2, + Float = float(Int), + [Int, Float, Float * 0.99, Float * 1.01 | Acc] + end, + [], + lists:seq(1,N)). + + +repeat(0, _, _) -> + ok; +repeat(N, Fun, Arg) -> + Fun(Arg), + repeat(N-1, Fun, Arg). + +copy_term(T) -> + Papa = self(), + P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end), + P ! T, + receive R -> R end. + +do_compare([Gen1, Gen2]) -> + M1 = Gen1(), + M2 = Gen2(), + %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]), + C = (M1 < M2), + Erlang = maps_lessthan(M1, M2), + C = Erlang, + ?CHECK(M1==M1, M1), + + %% Change one key from int to float (or vice versa) and check compare + ML1 = maps:to_list(M1), + {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1), + case K1 of + I when is_integer(I) -> + case maps:find(float(I),M1) of + error -> + M1f = maps:remove(I, maps:put(float(I), V1, M1)), + ?CHECK(M1f > M1, [M1f, M1]); + _ -> ok + end; + + F when is_float(F), round(F) == F -> + case maps:find(round(F),M1) of + error -> + M1i = maps:remove(F, maps:put(round(F), V1, M1)), + ?CHECK(M1i < M1, [M1i, M1]); + _ -> ok + end; + + _ -> ok % skip floats with decimals + end, + + ?CHECK(M2 == M2, [M2]). + + +maps_lessthan(M1, M2) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case erts_internal:cmp_term(K1,K2) of + -1 -> true; + 0 -> (V1 < V2); + 1 -> false + end; + + {S1, S2} -> + S1 < S2 + end. + +term_sort(L) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end, + L). + + +cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) -> + case {size(T1),size(T2)} of + {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact); + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end; + +cmp([H1|T1], [H2|T2], Exact) -> + case cmp(H1,H2, Exact) of + 0 -> cmp(T1,T2, Exact); + C -> C + end; + +cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) -> + cmp_maps(M1,M2,Exact); +cmp(M1, M2, Exact) -> + cmp_others(M1, M2, Exact). + +cmp_maps(M1, M2, Exact) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case cmp(K1, K2, true) of + 0 -> cmp(V1, V2, Exact); + C -> C + end; + + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end. + +cmp_others(I, F, true) when is_integer(I), is_float(F) -> + -1; +cmp_others(F, I, true) when is_float(F), is_integer(I) -> + 1; +cmp_others(T1, T2, _) -> + case {T1<T2, T1==T2} of + {true,false} -> -1; + {false,true} -> 0; + {false,false} -> 1 + end. + +map_gen(Pairs, Size) -> + {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> + KI = random:uniform(size(Keys)), + K = element(KI,Keys), + KV = element(random:uniform(size(K)), K), + {erlang:delete_element(KI,Keys), [KV | Acc]} + end, + {Pairs, []}, + lists:seq(1,Size)), + + maps:from_list(L). + + +recursive_compare() -> + Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()}, + {A, B} = term_gen_recursive(Leafs, 0, 0), + %%io:format("Recursive term A = ~p\n", [A]), + %%io:format("Recursive term B = ~p\n", [B]), + + ?CHECK({true,false} =:= case do_cmp(A, B, false) of + -1 -> {A<B, A>=B}; + 0 -> {A==B, A/=B}; + 1 -> {A>B, A=<B} + end, + {A,B}), + A2 = copy_term(A), + ?CHECK(A == A2, {A,A2}), + ?CHECK(0 =:= cmp(A, A2, false), {A,A2}), + + B2 = copy_term(B), + ?CHECK(B == B2, {B,B2}), + ?CHECK(0 =:= cmp(B, B2, false), {B,B2}), + ok. + +do_cmp(A, B, Exact) -> + C = cmp(A, B, Exact), + C. + +%% Generate two terms {A,B} that may only differ +%% at float vs integer types. +term_gen_recursive(Leafs, Flags, Depth) -> + MaxDepth = 10, + Rnd = case {Flags, Depth} of + {_, MaxDepth} -> % Only leafs + random:uniform(size(Leafs)) + 3; + {0, 0} -> % Only containers + random:uniform(3); + {0,_} -> % Anything + random:uniform(size(Leafs)+3) + end, + case Rnd of + 1 -> % Make map + Size = random:uniform(size(Leafs)), + lists:foldl(fun(_, {Acc1,Acc2}) -> + {K1,K2} = term_gen_recursive(Leafs, Flags, + Depth+1), + {V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1), + {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)} + end, + {maps:new(), maps:new()}, + lists:seq(1,Size)); + 2 -> % Make cons + {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1), + {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), + {[Car1 | Cdr1], [Car2 | Cdr2]}; + 3 -> % Make tuple + Size = random:uniform(size(Leafs)), + L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, + lists:seq(1,Size)), + {L1, L2} = lists:unzip(L), + {list_to_tuple(L1), list_to_tuple(L2)}; + + N -> % Make leaf + case element(N-3, Leafs) of + I when is_integer(I) -> + case random:uniform(4) of + 1 -> {I, float(I)}; + 2 -> {float(I), I}; + _ -> {I,I} + end; + T -> {T,T} + end + end. + +%% BIFs +t_bif_map_get(Config) when is_list(Config) -> + %% small map + 1 = maps:get(a, #{ a=> 1}), + 2 = maps:get(b, #{ a=> 1, b => 2}), + "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), + "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = maps:get(a, M1), + 2 = maps:get(b, M1), + "hi" = maps:get("hello", M1), + "tuple hi" = maps:get({1,1.0}, M1), + "v3" = maps:get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + (catch maps:get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + (catch maps:get(a, #{b=>1, c=>2})), + ok. + +t_bif_map_find(Config) when is_list(Config) -> + %% small map + {ok, 1} = maps:find(a, #{ a=> 1}), + {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), + {ok, "int"} = maps:find(1, #{ 1 => "int"}), + {ok, "float"} = maps:find(1.0, #{ 1.0=> "float"}), + + {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), + {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + {ok, 1} = maps:find(a, M1), + {ok, 2} = maps:find(b, M1), + {ok, "hi"} = maps:find("hello", M1), + {ok, "tuple hi"} = maps:find({1,1.0}, M1), + {ok, "v3"} = maps:find(<<"k2">>, M1), + + %% error case + error = maps:find(a,#{}), + error = maps:find(a,#{b=>1, c=>2}), + error = maps:find(1.0, #{ 1 => "int"}), + error = maps:find(1, #{ 1.0 => "float"}), + error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key + + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} = + (catch maps:find(a, T)) + end), + ok. + + +t_bif_map_is_key(Config) when is_list(Config) -> + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + + true = maps:is_key("hi", M1), + true = maps:is_key(int, M1), + true = maps:is_key(<<"key">>, M1), + true = maps:is_key(4, M1), + + false = maps:is_key(5, M1), + false = maps:is_key(<<"key2">>, M1), + false = maps:is_key("h", M1), + false = maps:is_key("hello", M1), + false = maps:is_key(atom, M1), + false = maps:is_key(any, #{}), + + false = maps:is_key("hi", maps:remove("hi", M1)), + true = maps:is_key("hi", M1), + true = maps:is_key(1, maps:put(1, "number", M1)), + false = maps:is_key(1.0, maps:put(1, "number", M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + (catch maps:is_key(a, T)) + end), + ok. + +t_bif_map_keys(Config) when is_list(Config) -> + [] = maps:keys(#{}), + + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} = + (catch maps:keys(T)) + end), + ok. + +t_bif_map_new(Config) when is_list(Config) -> + #{} = maps:new(), + 0 = erlang:map_size(maps:new()), + ok. + +t_bif_map_merge(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:merge(#{},#{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(#{}, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(M0, #{}), + + M1 = #{ "hi" => "hello again", float => 3.3, {1,2} => "tuple", 4 => integer }, + + #{4 := number, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello", <<"key">> := <<"value">>} = maps:merge(M1,M0), + + #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), + + %% try deep collisions + N = 150000, + Is = lists:seq(1,N), + M2 = maps:from_list([{I,I}||I<-Is]), + 150000 = maps:size(M2), + M3 = maps:from_list([{<<I:32>>,I}||I<-Is]), + 150000 = maps:size(M3), + M4 = maps:merge(M2,M3), + 300000 = maps:size(M4), + M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]), + 150000 = maps:size(M5), + M6 = maps:merge(M4,M5), + 450000 = maps:size(M6), + M7 = maps:from_list([{float(I),I}||I<-Is]), + 150000 = maps:size(M7), + M8 = maps:merge(M7,M6), + 600000 = maps:size(M8), + + #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8, + #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8, + #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8, + #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8, + #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8, + #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8, + + %% overlapping + M8 = maps:merge(M2,M8), + M8 = maps:merge(M3,M8), + M8 = maps:merge(M4,M8), + M8 = maps:merge(M5,M8), + M8 = maps:merge(M6,M8), + M8 = maps:merge(M7,M8), + M8 = maps:merge(M8,M8), + + %% maps:merge/2 and mixed + + Ks1 = [764492191,2361333849], %% deep collision + Ks2 = lists:seq(1,33), + M9 = maps:from_list([{K,K}||K <- Ks1]), + M10 = maps:from_list([{K,K}||K <- Ks2]), + M11 = maps:merge(M9,M10), + ok = check_keys_exist(Ks1 ++ Ks2, M11), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(#{}, T)), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, #{})), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, T)) + end), + ok. + + +t_bif_map_put(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), + + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), + + M2 = #{ int := 3 } = maps:put(int, 3, M1), + + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), + + M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), + + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), + + M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), + + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), + + M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), + + M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} = + (catch maps:put(1, a, T)) + end), + ok. + +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). + +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). + +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + + M2 = maps:remove(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + + M3 = maps:remove(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + + M4 = maps:remove(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = + (catch maps:remove(a, T)) + end), + ok. + +t_bif_map_update(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello again", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update("hi", "hello again", M0), + + #{ "hi" := "hello", int := 1337, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(int, 1337, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"new value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(<<"key">>, <<"new value">>, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := integer, 18446744073709551629 := wat} = maps:update(4, integer, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, T)) + end), + ok. + + + +t_bif_map_values(Config) when is_list(Config) -> + + [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), + + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), + + Vs = lists:seq(1000,20000), + M3 = maps:from_list([{K,K}||K<-Vs]), + M4 = maps:merge(M1,M3), + M5 = maps:merge(M2,M3), + true = is_members(Vs,maps:values(M3)), + true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)), + true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} = + (catch maps:values(T)) + end), + ok. + +t_erlang_hash(Config) when is_list(Config) -> + ok = t_bif_erlang_phash2(), + ok = t_bif_erlang_phash(), + ok. + +t_bif_erlang_phash2() -> + + 39679005 = erlang:phash2(#{}), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 + + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 + ok. + +t_bif_erlang_phash() -> + Sz = 1 bsl 32, + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 + + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 + ok. + +t_map_encode_decode(Config) when is_list(Config) -> + <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), + Pairs = [ + {a,b},{"key","values"},{<<"key">>,<<"value">>}, + {1,b},{[atom,1],{<<"wat">>,1,2,3}}, + {aa,"values"}, + {1 bsl 64 + (1 bsl 50 - 1), sc1}, + {99, sc2}, + {1 bsl 65 + (1 bsl 51 - 1), sc3}, + {88, sc4}, + {1 bsl 66 + (1 bsl 52 - 1), sc5}, + {77, sc6}, + {1 bsl 67 + (1 bsl 53 - 1), sc3}, + {75, sc6}, {-10,sc8}, + {<<>>, sc9}, {3.14158, sc10}, + {[3.14158], sc11}, {more_atoms, sc12}, + {{more_tuples}, sc13}, {self(), sc14}, + {{},{}},{[],[]} + ], + ok = map_encode_decode_and_match(Pairs,[],#{}), + + %% check sorting + + %% literally #{ b=>2, a=>1 } in the internal order + #{ a:=1, b:=2 } = + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,97,2,100,0,1,97,97,1>>), + + + %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order + #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, + 107,0,2,104,105, % "hi" :: list() + 107,0,5,118,97,108,117,101, % "value" :: list() + 100,0,1,97, % a :: atom() + 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() + 97,55 % 55 :: integer() + >>), + + %% Maps of different sizes + lists:foldl(fun(Key, M0) -> + M1 = M0#{Key => Key}, + case Key rem 17 of + 0 -> + M1 = binary_to_term(term_to_binary(M1)); + _ -> + ok + end, + M1 + end, + #{}, + lists:seq(1,10000)), + + %% many maps in same binary + MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end, + [#{}], + lists:seq(1,100)), + MapList = binary_to_term(term_to_binary(MapList)), + MapListR = lists:reverse(MapList), + MapListR = binary_to_term(term_to_binary(MapListR)), + + %% error cases + %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> + %% which is: #{ a=>1, b=>1 } + + %% uniqueness violation + %% literally #{ a=>1, "hi"=>"value", a=>2 } + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,3, + 100,0,1,97, + 97,1, + 107,0,2,104,105, + 107,0,5,118,97,108,117,101, + 100,0,1,97, + 97,2>>)), + + %% bad size (too large) + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,97,1,100,0,1,98,97,1>>)), + + %% bad size (too small) .. should fail just truncate it .. weird. + %% possibly change external format so truncated will be #{a:=1} + #{ a:=b } = + erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + ok. + +map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> + M1 = maps:put(K,V,M0), + B0 = erlang:term_to_binary(M1), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), + %% decode and match it + M1 = erlang:binary_to_term(B0), + map_encode_decode_and_match(Pairs,Ls,M1); +map_encode_decode_and_match([],_,_) -> ok. + +match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> + match_encoded_map_stripped_size(Encoded,Items,Items); +match_encoded_map(_,_,_) -> no_match_size. + +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. + + +t_bif_map_to_list(Config) when is_list(Config) -> + [] = maps:to_list(#{}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), + + %% error cases + do_badmap(fun(T) -> + {'EXIT', {{badmap,T},_}} = + (catch maps:to_list(T)) + end), + ok. + + +t_bif_map_from_list(Config) when is_list(Config) -> + #{} = maps:from_list([]), + A = maps:from_list([]), + 0 = erlang:map_size(A), + + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), + #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), + + #{a:=2} = maps:from_list([{a,1},{a,3},{a,2}]), + + #{ <<"hi">>:=v1,3:=v3,"hi":=v6,hi:=v4,{hi,3}:=v5} = + maps:from_list([{3,v3},{"hi",v6},{hi,v4},{{hi,3},v5},{<<"hi">>,v1}]), + + #{<<"hi">>:=v6,3:=v8,"hi":=v11,hi:=v9,{hi,3}:=v10} = + maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, + {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + + %% repeated keys (large -> small) + Ps1 = [{a,I}|| I <- lists:seq(1,32)], + Ps2 = [{a,I}|| I <- lists:seq(33,64)], + + M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2), + #{ a := 64, b := 1, c := 1 } = M, + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},b])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},{b,b,3}])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},<<>>])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b}|{b,a}])), + {'EXIT', {badarg,_}} = (catch maps:from_list(a)), + {'EXIT', {badarg,_}} = (catch maps:from_list(42)), + ok. + +t_bif_build_and_check(Config) when is_list(Config) -> + ok = check_build_and_remove(750,[ + fun(K) -> [K,K] end, + fun(K) -> [float(K),K] end, + fun(K) -> K end, + fun(K) -> {1,K} end, + fun(K) -> {K} end, + fun(K) -> [K|K] end, + fun(K) -> [K,1,2,3,4] end, + fun(K) -> {K,atom} end, + fun(K) -> float(K) end, + fun(K) -> integer_to_list(K) end, + fun(K) -> list_to_atom(integer_to_list(K)) end, + fun(K) -> [K,{K,[K,{K,[K]}]}] end, + fun(K) -> <<K:32>> end + ]), + + ok. + +check_build_and_remove(_,[]) -> ok; +check_build_and_remove(N,[F|Fs]) -> + {M,Ks} = build_and_check(N, maps:new(), F, []), + ok = remove_and_check(Ks,M), + check_build_and_remove(N,Fs). + +build_and_check(0, M0, _, Ks) -> {M0, Ks}; +build_and_check(N, M0, F, Ks) -> + K = build_key(F,N), + M1 = maps:put(K,K,M0), + ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1), + M2 = maps:update(K,v,M1), + v = maps:get(K,M2), + build_and_check(N-1,M1,F,[{K,M1}|Ks]). + +remove_and_check([],_) -> ok; +remove_and_check([{K,Mc}|Ks], M0) -> + K = maps:get(K,M0), + true = maps:is_key(K,M0), + true = Mc =:= M0, + true = M0 == Mc, + M1 = maps:remove(K,M0), + false = M1 =:= Mc, + false = Mc == M1, + false = maps:is_key(K,M1), + true = maps:is_key(K,M0), + ok = check_keys_exist([I||{I,_} <- Ks],M1), + error = maps:find(K,M1), + remove_and_check(Ks, M1). + +build_key(F,N) when N rem 3 =:= 0 -> F(N); +build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K}; +build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K]. + +check_keys_exist([], _) -> ok; +check_keys_exist([K|Ks],M) -> + true = maps:is_key(K,M), + check_keys_exist(Ks,M). + +t_bif_merge_and_check(Config) when is_list(Config) -> + + io:format("rand:export_seed() -> ~p\n",[rand:export_seed()]), + + %% simple disjunct ones + %% make sure all keys are unique + Kss = [[a,b,c,d], + [1,2,3,4], + [], + ["hi"], + [e], + [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)], + lists:seq(5, 28), + lists:seq(29, 59), + [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)], + [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)], + [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]], + + + KsMs = build_keys_map_pairs(Kss), + Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs], + ok = merge_and_check_combo(Cs), + + %% overlapping ones + + KVs1 = [{a,1},{b,2},{c,3}], + KVs2 = [{b,3},{c,4},{d,5}], + KVs = [{I,I} || I <- lists:seq(1,32)], + KVs3 = KVs1 ++ KVs, + KVs4 = KVs2 ++ KVs, + + M1 = maps:from_list(KVs1), + M2 = maps:from_list(KVs2), + M3 = maps:from_list(KVs3), + M4 = maps:from_list(KVs4), + + M12 = maps:merge(M1,M2), + ok = check_key_values(KVs2 ++ [{a,1}], M12), + M21 = maps:merge(M2,M1), + ok = check_key_values(KVs1 ++ [{d,5}], M21), + + M34 = maps:merge(M3,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M34), + M43 = maps:merge(M4,M3), + ok = check_key_values(KVs3 ++ [{d,5}], M43), + + M14 = maps:merge(M1,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M14), + M41 = maps:merge(M4,M1), + ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41), + + [begin Ma = random_map(SzA, a), + Mb = random_map(SzB, b), + ok = merge_maps(Ma, Mb) + end || SzA <- [3,10,20,100,200,1000], SzB <- [3,10,20,100,200,1000]], + + ok. + +% Generate random map with an average of Sz number of pairs: K -> {V,K} +random_map(Sz, V) -> + random_map_insert(#{}, 0, V, Sz*2). + +random_map_insert(M0, K0, _, Sz) when K0 > Sz -> + M0; +random_map_insert(M0, K0, V, Sz) -> + Key = K0 + rand:uniform(3), + random_map_insert(M0#{Key => {V,Key}}, Key, V, Sz). + + +merge_maps(A, B) -> + AB = maps:merge(A, B), + %%io:format("A=~p\nB=~p\n",[A,B]), + maps_foreach(fun(K,VB) -> VB = maps:get(K, AB) + end, B), + maps_foreach(fun(K,VA) -> + case {maps:get(K, AB),maps:find(K, B)} of + {VA, error} -> ok; + {VB, {ok, VB}} -> ok + end + end, A), + + maps_foreach(fun(K,V) -> + case {maps:find(K, A),maps:find(K, B)} of + {{ok, V}, error} -> ok; + {error, {ok, V}} -> ok; + {{ok,_}, {ok, V}} -> ok + end + end, AB), + ok. + +maps_foreach(Fun, Map) -> + maps:fold(fun(K,V,_) -> Fun(K,V) end, void, Map). + + +check_key_values([],_) -> ok; +check_key_values([{K,V}|KVs],M) -> + V = maps:get(K,M), + check_key_values(KVs,M). + +merge_and_check_combo([]) -> ok; +merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) -> + M12 = maps:merge(M1,M2), + ok = check_keys_exist(Ks1 ++ Ks2, M12), + M21 = maps:merge(M2,M1), + ok = check_keys_exist(Ks1 ++ Ks2, M21), + + true = M12 =:= M21, + M12 = M21, + + merge_and_check_combo(Cs). + +build_keys_map_pairs([]) -> []; +build_keys_map_pairs([Ks|Kss]) -> + M = maps:from_list(keys_to_pairs(Ks)), + ok = check_keys_exist(Ks, M), + [{Ks,M}|build_keys_map_pairs(Kss)]. + +keys_to_pairs(Ks) -> [{K,K} || K <- Ks]. + + +%% Maps module, not BIFs +t_maps_fold(_Config) -> + Vs = lists:seq(1,100), + M = maps:from_list([{{k,I},{v,I}}||I<-Vs]), + + %% fold + 5050 = maps:fold(fun({k,_},{v,V},A) -> V + A end, 0, M), + + ok. + +t_maps_map(_Config) -> + Vs = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I<-Vs]), + M2 = maps:from_list([{I,{token,I}}||I<-Vs]), + + M2 = maps:map(fun(_K,V) -> {token,V} end, M1), + ok. + +t_maps_size(_Config) -> + Vs = lists:seq(1,100), + lists:foldl(fun(I,M) -> + M1 = maps:put(I,I,M), + I = maps:size(M1), + M1 + end, #{}, Vs), + ok. + + +t_maps_without(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_erts_internal_order(_Config) when is_list(_Config) -> + M = #{0 => 0,2147483648 => 0}, + true = M =:= binary_to_term(term_to_binary(M)), + + F1 = fun(_, _) -> 0 end, + F2 = fun(_, _) -> 1 end, + M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]), + M1 = maps:merge(M0, #{0 => 1}), + 8 = maps:size(M1), + 1 = maps:get(0,M1), + ok. + +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), + + M1 = M#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = M#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), + ok. + +t_pdict(_Config) -> + + put(#{ a => b, b => a},#{ c => d}), + put(get(#{ a => b, b => a}),1), + 1 = get(#{ c => d}), + #{ c := d } = get(#{ a => b, b => a}). + +t_ets(_Config) -> + + Tid = ets:new(map_table,[]), + + [ets:insert(Tid,{maps:from_list([{I,-I}]),I}) || I <- lists:seq(1,100)], + + + [{#{ 2 := -2},2}] = ets:lookup(Tid,#{ 2 => -2 }), + + %% Test equal + [3,4] = lists:sort( + ets:select(Tid,[{{'$1','$2'}, + [{'or',{'==','$1',#{ 3 => -3 }}, + {'==','$1',#{ 4 => -4 }}}], + ['$2']}])), + %% Test match + [30,50] = lists:sort( + ets:select(Tid, + [{{#{ 30 => -30}, '$1'},[],['$1']}, + {{#{ 50 => -50}, '$1'},[],['$1']}] + )), + + ets:insert(Tid,{#{ a => b, b => c, c => a},transitivity}), + + %% Test equal with map of different size + [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), + + %% Test match with map of different size + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + + %%% Test match with don't care value + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + + %% Test is_map bif + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{not_a_map,2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{{nope,a,tuple},2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + + %% Test map_size bif + [3] = ets:select(Tid,[{{'$1','_'},[{'==',{map_size,'$1'},3}], + [{map_size,'$1'}]}]), + + true = ets:delete(Tid,#{50 => -50}), + [] = ets:lookup(Tid,#{50 => -50}), + + ets:delete(Tid), + ok. + +t_dets(_Config) -> + ok. + +t_tracing(_Config) -> + + dbg:stop_clear(), + {ok,Tracer} = dbg:tracer(process,{fun trace_collector/2, self()}), + dbg:p(self(),c), + + %% Test basic map call + {ok,_} = dbg:tpl(?MODULE,id,x), + #{ a => b }, + {trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ a := b }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test equals in argument list + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==','$1',#{ b => c}}], + [{return_trace}]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ b := c }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test match in head + {ok,_} = dbg:tpl(?MODULE,id,[{[#{b => c}],[],[]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + dbg:ctpl(), + + % Test map guard bifs + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{is_map,{element,1,'$1'}}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {trace,_,call,{?MODULE,id,[{#{ a := b },2}]}} = getmsg(Tracer), + dbg:ctpl(), + + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==',{map_size,{element,1,'$1'}},2}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {#{ a => b, b => c},atom}, + {trace,_,call,{?MODULE,id,[{#{ a := b, b := c },atom}]}} = getmsg(Tracer), + dbg:ctpl(), + + %MS = dbg:fun2ms(fun([A]) when A == #{ a => b} -> ok end), + %dbg:tpl(?MODULE,id,MS), + %#{ a => b }, + %#{ b => c }, + %{trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + %dbg:ctpl(), + + %% Check to extra messages + timeout = getmsg(Tracer), + + dbg:stop_clear(), + ok. + +getmsg(_Tracer) -> + receive V -> V after 100 -> timeout end. + +trace_collector(Msg,Parent) -> + io:format("~p~n",[Msg]), + Parent ! Msg, + Parent. + +t_has_map_fields(Config) when is_list(Config) -> + true = has_map_fields_1(#{one=>1}), + true = has_map_fields_1(#{one=>1,two=>2}), + false = has_map_fields_1(#{two=>2}), + false = has_map_fields_1(#{}), + + true = has_map_fields_2(#{c=>1,b=>2,a=>3}), + true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}), + false = has_map_fields_2(#{b=>2,c=>1}), + false = has_map_fields_2(#{x=>y}), + false = has_map_fields_2(#{}), + + true = has_map_fields_3(#{c=>1,b=>2,a=>3}), + true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}), + true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{[]=>42,42.0=>43}), + false = has_map_fields_3(#{b=>2,c=>1}), + false = has_map_fields_3(#{[]=>y}), + false = has_map_fields_3(#{42.0=>x,a=>99}), + false = has_map_fields_3(#{}), + + ok. + +has_map_fields_1(#{one:=_}) -> true; +has_map_fields_1(#{}) -> false. + +has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true; +has_map_fields_2(#{}) -> false. + +has_map_fields_3(#{a:=_,b:=_}) -> true; +has_map_fields_3(#{[]:=_,42.0:=_}) -> true; +has_map_fields_3(#{}) -> false. + +y_regs(Config) when is_list(Config) -> + Val = [length(Config)], + Map0 = y_regs_update(#{}, Val), + Map2 = y_regs_update(Map0, Val), + + Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]), + Map4 = y_regs_update(Map3, Val), + + true = is_map(Map2) andalso is_map(Map4), + + ok. + +y_regs_update(Map0, Val0) -> + Val1 = {t,Val0}, + K1 = {key,1}, + K2 = {key,2}, + Map1 = Map0#{K1=>K1, + a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0, + f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0, + k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0, + p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0, + u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0, + z=>Val0, + aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0, + af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0, + ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0, + ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0, + au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0, + az=>Val0, + K2=>[a,b,c]}, + Map2 = Map1#{K1=>K1, + a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1, + f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1, + k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1, + p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1, + u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1, + z:=Val1, + aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1, + af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1, + ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1, + ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1, + au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1, + az:=Val1, + K2=>[a,b,c]}, + + %% Traverse the maps to validate them. + _ = erlang:phash2({Map1,Map2}, 100000), + + _ = {K1,K2,Val0,Val1}, %Force use of Y registers. + Map2. + +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/-1, + <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/order.erl b/lib/dialyzer/test/indent_SUITE_data/src/order.erl new file mode 100644 index 0000000000..51868d7e94 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/order.erl @@ -0,0 +1,56 @@ +-module(order). + +-export([t1/0, t2/0, t3/0, t4/0, t5/0, t6/0]). + +t1() -> + case maps:get(a, #{a=>1, a=>b}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t2() -> + case maps:get(a, #{a=>id_1(1), a=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t3() -> + case maps:get(a, #{a=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t4() -> + case maps:get(a, #{a=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> ok; + Atom when is_atom(Atom) -> ok; + _Else -> fail + end. + +t5() -> + case maps:get(c, #{c=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> error(ok); + Atom when is_atom(Atom) -> fail; + _Else -> fail + end. + +t6() -> + case maps:get(a, #{a_or_b()=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +id_1(X) -> X. + +id_a(X) -> X. + +id_b(X) -> X. + +any() -> binary_to_term(<<>>). + +-spec a_or_b() -> a | b. +a_or_b() -> any(). diff --git a/lib/dialyzer/test/indent_SUITE_data/src/queue_use.erl b/lib/dialyzer/test/indent_SUITE_data/src/queue_use.erl new file mode 100644 index 0000000000..8d46bdb989 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/queue_use.erl @@ -0,0 +1,65 @@ +-module(queue_use). + +-export([ok1/0, ok2/0]). +-export([wrong1/0, wrong2/0, wrong3/0, wrong4/0, wrong5/0, wrong6/0, wrong7/0, wrong8/0]). + +ok1() -> + queue:is_empty(queue:new()). + +ok2() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + {{value, 42}, Q2} = queue:out(Q1), + queue:is_empty(Q2). + +%%-------------------------------------------------- + +wrong1() -> + queue:is_empty({[],[]}). + +wrong2() -> + Q0 = {[],[]}, + queue:in(42, Q0). + +wrong3() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + {[42],Q2} = Q1, + Q2. + +wrong4() -> + Q0 = queue:new(), + Q1 = queue:in(42, Q0), + Q1 =:= {[42],[]}. + +wrong5() -> + {F, _R} = queue:new(), + F. + +wrong6() -> + {{value, 42}, Q2} = queue:out({[42],[]}), + Q2. + +%%-------------------------------------------------- + +-record(db, {p, q}). + +wrong7() -> + add_unique(42, #db{p = [], q = queue:new()}). + +add_unique(E, DB) -> + case is_in_queue(E, DB) of + true -> DB; + false -> DB#db{q = queue:in(E, DB#db.q)} + end. + +is_in_queue(P, #db{q = {L1,L2}}) -> + lists:member(P, L1) orelse lists:member(P, L2). + +%%-------------------------------------------------- + +wrong8() -> + tuple_queue({42, gazonk}). + +tuple_queue({F, Q}) -> + queue:in(F, Q). diff --git a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl new file mode 100644 index 0000000000..f01cc5e519 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl @@ -0,0 +1,22 @@ +-module(rec_adt). + +-export([new/0, get_a/1, get_b/1, set_a/2, set_b/2]). + +-record(rec, {a :: atom(), b = 0 :: integer()}). + +-opaque rec() :: #rec{}. + +-spec new() -> rec(). +new() -> #rec{a = gazonk, b = 42}. + +-spec get_a(rec()) -> atom(). +get_a(#rec{a = A}) -> A. + +-spec get_b(rec()) -> integer(). +get_b(#rec{b = B}) -> B. + +-spec set_a(rec(), atom()) -> rec(). +set_a(R, A) -> R#rec{a = A}. + +-spec set_b(rec(), integer()) -> rec(). +set_b(R, B) -> R#rec{b = B}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl new file mode 100644 index 0000000000..358e9f918c --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl @@ -0,0 +1,30 @@ +-module(rec_use). + +-export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0, wrong4/0]). + +ok1() -> + rec_adt:set_a(rec_adt:new(), foo). + +ok2() -> + R1 = rec_adt:new(), + B1 = rec_adt:get_b(R1), + R2 = rec_adt:set_b(R1, 42), + B2 = rec_adt:get_b(R2), + B1 =:= B2. + +wrong1() -> + case rec_adt:new() of + {rec, _, 42} -> weird1; + R when tuple_size(R) =:= 3 -> weird2 + end. + +wrong2() -> + R = list_to_tuple([rec, a, 42]), + rec_adt:get_a(R). + +wrong3() -> + R = rec_adt:new(), + R =:= {rec, gazonk, 42}. + +wrong4() -> + tuple_size(rec_adt:new()). diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_construct.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_construct.erl new file mode 100644 index 0000000000..b250c6ee65 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_construct.erl @@ -0,0 +1,21 @@ +-module(record_construct). +-export([t_loc/0, t_opa/0, t_rem/0]). + +-record(r_loc, {a = gazonk :: integer(), b = 42 :: atom()}). + +t_loc() -> + #r_loc{}. + +-record(r_opa, {a :: atom(), + b = gb_sets:new() :: gb_sets:set(), + c = 42 :: boolean(), + d, % untyped on purpose + e = false :: boolean()}). + +t_opa() -> + #r_opa{}. + +-record(r_rem, {a = gazonk :: string()}). + +t_rem() -> + #r_rem{}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_creation_diffs.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_creation_diffs.erl new file mode 100644 index 0000000000..e813459f8e --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_creation_diffs.erl @@ -0,0 +1,11 @@ +-module(record_creation_diffs). + +-export([foo/1]). + +-record(bar, { + some_atom :: atom(), + some_list :: list() + }). + +foo(Input) -> + #bar{some_atom = Input, some_list = {this,is,a,tuple}}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_match.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_match.erl new file mode 100644 index 0000000000..8e9b91937f --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_match.erl @@ -0,0 +1,17 @@ +-module(record_match). + +-export([select/0]). + +-record(b_literal, {val}). +-record(b_remote, {mod,name,arity}). +-record(b_local, {name,arity}). + +-type b_remote() :: #b_remote{}. +-type b_local() :: #b_local{}. + +-type argument() :: b_remote() | b_local(). + +-record(b_set, {args=[] :: [argument()]}). + +select() -> + #b_set{args=[#b_remote{},#b_literal{}]}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_pat.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_pat.erl new file mode 100644 index 0000000000..3308641571 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_pat.erl @@ -0,0 +1,15 @@ +%%%------------------------------------------------------------------- +%%% File : record_pat.erl +%%% Author : Tobias Lindahl <> +%%% Description : Emit warning if a pattern violates the record type +%%% +%%% Created : 21 Oct 2008 by Tobias Lindahl <> +%%%------------------------------------------------------------------- +-module(record_pat). + +-export([t/1]). + +-record(foo, {bar :: integer()}). + +t(#foo{bar=baz}) -> no_way; +t(#foo{bar=1}) -> ok. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_send_test.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_send_test.erl new file mode 100644 index 0000000000..87cd97bd85 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_send_test.erl @@ -0,0 +1,32 @@ +%%------------------------------------------------------------------- +%% File : record_send_test.erl +%% Author : Kostis Sagonas <[email protected]> +%% Description : A test inspired by a post of Mkcael Remond to the +%% Erlang mailing list suggesting thst Dialyzer should +%% be reporting sends to records rather than to pids. +%% Dialyzer v1.3.0 indeed reports one of the dicrepancies +%% (the one with the 4-tuple) but not the one where the +%% message is sent to a pair which is a record. +%% This should be fixed. +%% +%% Created : 10 Apr 2005 by Kostis Sagonas <[email protected]> +%%------------------------------------------------------------------- +-module(record_send_test). + +-export([t/0]). + +-record(rec1, {a=a, b=b, c=c}). +-record(rec2, {a}). + +t() -> + t(#rec1{}). + +t(Rec1 = #rec1{b=B}) -> + Rec2 = some_mod:some_function(), + if + is_record(Rec2, rec2) -> + Rec2 ! hello; %% currently this one is not found + true -> + Rec1 ! hello_again + end, + B. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_test.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_test.erl new file mode 100644 index 0000000000..48a00b172e --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_test.erl @@ -0,0 +1,22 @@ +%%%------------------------------------------------------------------- +%%% File : record_test.erl +%%% Author : Tobias Lindahl <[email protected]> +%%% Description : +%%% +%%% Created : 22 Oct 2004 by Tobias Lindahl <[email protected]> +%%%------------------------------------------------------------------- +-module(record_test). + +-export([t/0]). + +-record(foo, {bar}). + +t() -> + doit(foo). + +doit(X) -> + case X of + #foo{} -> error1; + foo -> ok; + _ -> error2 + end. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/record_update.erl b/lib/dialyzer/test/indent_SUITE_data/src/record_update.erl new file mode 100644 index 0000000000..bad7a0a929 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/record_update.erl @@ -0,0 +1,10 @@ +-module(record_update). + +-export([quux/2]). + +-record(foo, {bar :: atom()}). + +-spec quux(#foo{}, string()) -> #foo{}. + +quux(Foo, NotBar) -> + Foo#foo{ bar = NotBar }. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_behaviour.erl b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_behaviour.erl new file mode 100644 index 0000000000..116980986b --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_behaviour.erl @@ -0,0 +1,13 @@ +-module(sample_behaviour). + +-type custom() :: 1..42. + +-callback sample_callback_1() -> term(). +-callback sample_callback_2() -> atom(). +-callback sample_callback_3() -> {'ok', custom()} | 'fail'. + +-callback sample_callback_4(term()) -> 'ok'. +-callback sample_callback_5(custom()) -> 'ok' | 'fail'. + +-callback sample_callback_6(custom(), custom(), string()) -> + {'ok', custom()} | 'fail'. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct.erl b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct.erl new file mode 100644 index 0000000000..ab0378e6f0 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct.erl @@ -0,0 +1,32 @@ +-module(sample_callback_correct). + +-behaviour(sample_behaviour). + +-export([ + sample_callback_1/0, + sample_callback_2/0, + sample_callback_3/0, + sample_callback_4/1, + sample_callback_5/1, + sample_callback_6/3 + ]). + +sample_callback_1() -> 42. % This is a valid return. +sample_callback_2() -> foo. % This is a valid return. +sample_callback_3() -> {ok, 17}. % This is a valid return. +sample_callback_4(Input) -> + put(mine, Input+1), % This is valid handling of the input + ok. % This is a valid return. +sample_callback_5(Input) -> + case Input - 1 < 22 of % This is valid handling of the input + true -> ok; % This is a valid return. + false -> fail % This is a valid return. + end. +sample_callback_6(OldNr, NewNr, Reason) -> + Diff = NewNr - OldNr, % This is valid handling of the input + Msg = string:join(["Reason: ", Reason], ","), % This is valid handling of the input + case Diff > 0 of + true -> put(mine, {NewNr, Msg}), + {ok, NewNr}; % This is a valid return. + false -> fail % This is a valid return. + end. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct_2.erl b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct_2.erl new file mode 100644 index 0000000000..c218174e58 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_correct_2.erl @@ -0,0 +1,38 @@ +-module(sample_callback_correct_2). + +-behaviour(sample_behaviour). + +-export([ + sample_callback_1/0, + sample_callback_2/0, + sample_callback_3/0, + sample_callback_4/1, + sample_callback_5/1, + sample_callback_6/3, + common_infrastructure/1 + ]). + +sample_callback_1() -> 42. % This is a valid return. +sample_callback_2() -> halt(). % Crashes are also allowed. +sample_callback_3() -> {ok, 17}. % This is a valid return. +sample_callback_4(Input) -> + case Input of + 1 -> common_infrastructure(Input); % This is 'correct' input for + _ -> ok % common_infrastructure. + end. +sample_callback_5(Input) -> + case get(Input) of % This is valid handling of a more generic input + true -> ok; % This is a valid return. + false -> fail % This is a valid return. + end. +sample_callback_6(OldNr, NewNr, Reason) -> + Diff = NewNr - OldNr, % This is valid handling of the input + Msg = string:join(["Reason: ", Reason], ","), % This is valid handling of the input + case Diff > 0 of + true -> put(mine, {NewNr, Msg}), + {ok, NewNr}; % This is a valid return. + false -> fail % This is a valid return. + end. + +common_infrastructure( 1) -> 'ok'; +common_infrastructure(42) -> 'fail'. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_wrong.erl b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_wrong.erl new file mode 100644 index 0000000000..430494c48c --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/sample_behaviour/sample_callback_wrong.erl @@ -0,0 +1,26 @@ +-module(sample_callback_wrong). + +%% This attribute uses the american spelling of 'behaviour'. +-behavior(sample_behaviour). + +-export([ +% sample_callback_1/0, + sample_callback_2/0, + sample_callback_3/0, + sample_callback_4/1, + sample_callback_5/1, + sample_callback_6/3 + ]). + +% sample_callback_1() -> 41. % We can't really break this contract so: missing! +sample_callback_2() -> 42. % This is not an atom(). +sample_callback_3() -> fair. % This is probably a typo. +sample_callback_4(_) -> % We cannot break the input. + fail. % We can definitely return a wrong value however. :) +sample_callback_5(Input) -> % Input is treated as an atom, result is a list. + atom_to_list(Input). % Both violate the contract. +sample_callback_6(OldNr, NewNr, Reason) -> + Diff = NewNr - OldNr, % This is valid handling of the input + %% Reason should have been treated as a string. + Msg = string:join(["Reason: ", atom_to_list(Reason)], ","), + {okk, NewNr}. %% This, too, is a typo. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_adt.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_adt.erl new file mode 100644 index 0000000000..7103847ae7 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_adt.erl @@ -0,0 +1,17 @@ +-module(exact_adt). + +-export([exact_adt_set_type/1, exact_adt_set_type2/1]). + +-export_type([exact_adt/0]). + +-record(exact_adt, {}). + +-opaque exact_adt() :: #exact_adt{}. + +-spec exact_adt_set_type(_) -> exact_adt(). + +exact_adt_set_type(G) -> G. + +-spec exact_adt_set_type2(exact_adt()) -> exact_adt(). + +exact_adt_set_type2(G) -> G. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_api.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_api.erl new file mode 100644 index 0000000000..597460ce77 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/exact_api.erl @@ -0,0 +1,60 @@ +-module(exact_api). + +-export([new/0, exact_api_test/1, exact_api_new/1, + exact_adt_test/1, exact_adt_new/1]). + +-export_type([exact_api/0]). + +-record(digraph, {vtab = notable :: ets:tab(), + etab = notable :: ets:tab(), + ntab = notable :: ets:tab(), + cyclic = true :: boolean()}). + +-spec new() -> digraph:graph(). + +new() -> + A = #digraph{}, + set_type(A), % does not have an opaque term as 1st argument + A. + +-spec set_type(digraph:graph()) -> true. + +set_type(G) -> + digraph:delete(G). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%% The derived spec of exact_api_new() is +%%% -spec exact_api_new(exact_api:exact_api()) -> exact_api:exact_api(). +%%% This won't happen unless dialyzer_typesig uses +%%% t_is_exactly_equal() rather than t_is_equal(). +%%% [As of R17B the latter considers two types equal if nothing but +%%% their ?opaque tags differ.] + +-record(exact_api, {}). + +-opaque exact_api() :: #exact_api{}. + +exact_api_test(X) -> + #exact_api{} = exact_api_set_type(X). % OK + +exact_api_new(A) -> + A = #exact_api{}, + _ = exact_api_set_type(A), % OK (the opaque type is local) + A. + +-spec exact_api_set_type(exact_api()) -> exact_api(). + +exact_api_set_type(#exact_api{}=E) -> E. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-record(exact_adt, {}). + +exact_adt_test(X) -> + #exact_adt{} = exact_adt:exact_adt_set_type(X). % breaks the opacity + +exact_adt_new(A) -> + A = #exact_adt{}, + _ = exact_adt:exact_adt_set_type2(A), % does not have an opaque term as 1st argument + A. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/is_rec.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/is_rec.erl new file mode 100644 index 0000000000..b906431b44 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/is_rec.erl @@ -0,0 +1,65 @@ +-module(is_rec). + +-export([ri1/0, ri11/0, ri13/0, ri14/0, ri2/0, ri3/0, ri4/0, ri5/0, + ri6/0, ri7/0, ri8/0]). + +-record(r, {f1 :: integer()}). + +ri1() -> + A = simple1_adt:d1(), + is_record(A, r). % opaque term 1 + +ri11() -> + A = simple1_adt:d1(), + I = '1-3'(), + is_record(A, r, I). % opaque term 1 + +ri13() -> + A = simple1_adt:d1(), + if is_record(A, r) -> true end. % breaks the opacity + +ri14() -> + A = simple1_adt:d1(), + if is_record({A, 1}, r) -> true end. % breaks the opacity + +-type '1-3-t'() :: 1..3. + +-spec '1-3'() -> '1-3-t'(). + +'1-3'() -> + random:uniform(3). + + +-spec 'Atom'() -> atom(). + +'Atom'() -> + a. + +ri2() -> + A = simple1_adt:d1(), + R = 'Atom'(), + is_record(A, R). % opaque term 1 + +ri3() -> + A = simple1_adt:d1(), + is_record(A, A, 1). % opaque term 2 + +ri4() -> + A = simple1_adt:d1(), + is_record(A, hipp:hopp(), 1). % opaque term 1 + +ri5() -> + A = simple1_adt:d1(), + is_record(A, A, hipp:hopp()). % opaque term 2 + +ri6() -> + A = simple1_adt:d1(), + if is_record(A, r) -> true end. % breaks opacity + +ri7() -> + A = simple1_adt:d1(), + if is_record({r, A}, r) -> true end. % A violates #r{} + +ri8() -> + A = simple1_adt:d1(), + is_record({A, 1}, r). % opaque term 1 diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_adt.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_adt.erl new file mode 100644 index 0000000000..ff80d6e99b --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_adt.erl @@ -0,0 +1,28 @@ +-module(rec_adt). + +-export([f/0, r1/0]). + +-export_type([r1/0]). + +-export_type([f/0, op_t/0, a/0]). + +-opaque a() :: a | b. + +-record(r1, + {f1 :: a()}). + +-opaque r1() :: #r1{}. + +-opaque f() :: fun((_) -> _). + +-opaque op_t() :: integer(). + +-spec f() -> f(). + +f() -> + fun(_) -> 3 end. + +-spec r1() -> r1(). + +r1() -> + #r1{f1 = a}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_api.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_api.erl new file mode 100644 index 0000000000..59b9e0fec4 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/rec_api.erl @@ -0,0 +1,123 @@ +-module(rec_api). + +-export([t1/0, t2/0, t3/0, adt_t1/0, adt_t1/1, adt_r1/0, + t/1, t_adt/0, r/0, r_adt/0, u1/0, u2/0, u3/0, v1/0, v2/0, v3/0]). + +-export_type([{a,0},{r1,0}, r2/0, r3/0]). + +-export_type([f/0, op_t/0, r/0, tup/0]). + +-opaque a() :: a | b. + +-record(r1, + {f1 :: a()}). + +-opaque r1() :: #r1{}. + +t1() -> + A = #r1{f1 = a}, + {r1, a} = A. + +t2() -> + A = {r1, 10}, + {r1, 10} = A, + A = #r1{f1 = 10}, % violates the type of field f1 + #r1{f1 = 10} = A. + +t3() -> + A = {r1, 10}, + #r1{f1 = 10} = A. % violates the type of #r1{} + +adt_t1() -> + R = rec_adt:r1(), + {r1, a} = R. % breaks the opacity + +-spec adt_t1(rec_adt:r1()) -> rec_adt:r1(). % invalid type spec + +adt_t1(R) -> + {r1, a} = R. + +-spec adt_r1() -> rec_adt:r1(). % invalid type spec + +adt_r1() -> + #r1{f1 = a}. + +-opaque f() :: fun((_) -> _). + +-opaque op_t() :: integer(). + +-spec t(f()) -> _. + +t(A) -> + T = term(), + %% 3(T), % cannot test this: dialyzer_dep deliberately crashes + A(T). + +-spec term() -> op_t(). + +term() -> + 3. + +t_adt() -> + A = rec_adt:f(), + T = term(), + A(T). + +-record(r, {f = fun(_) -> 3 end :: f(), o = 1 :: op_t()}). + +-opaque r() :: #r{}. + +-opaque tup() :: {'r', f(), op_t()}. + +-spec r() -> _. + +r() -> + {{r, f(), 2}, + #r{f = f(), o = 2}}. % OK, f() is a local opaque type + +-spec f() -> f(). + +f() -> + fun(_) -> 3 end. + +r_adt() -> + {{r, rec_adt:f(), 2}, + #r{f = rec_adt:f(), o = 2}}. % breaks the opacity + +-record(r2, % like #r1{}, but with initial value + {f1 = a :: a()}). + +-opaque r2() :: #r2{}. + +u1() -> + A = #r2{f1 = a}, + {r2, a} = A. + +u2() -> + A = {r2, 10}, + {r2, 10} = A, + A = #r2{f1 = 10}, % violates the type of field f1 + #r2{f1 = 10} = A. + +u3() -> + A = {r2, 10}, + #r2{f1 = 10} = A. % violates the type of #r2{} + +-record(r3, % like #r1{}, but an opaque type + {f1 = queue:new():: queue:queue()}). + +-opaque r3() :: #r3{}. + +v1() -> + A = #r3{f1 = queue:new()}, + {r3, a} = A. % breaks the opacity + +v2() -> + A = {r3, 10}, + {r3, 10} = A, + A = #r3{f1 = 10}, % violates the type of field f1 + #r3{f1 = 10} = A. + +v3() -> + A = {r3, 10}, + #r3{f1 = 10} = A. % breaks the opacity diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_adt.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_adt.erl new file mode 100644 index 0000000000..21a277c1e9 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_adt.erl @@ -0,0 +1,138 @@ +-module(simple1_adt). + +-export([d1/0, d2/0, i/0, n1/0, n2/0, o1/0, o2/0, + c1/0, c2/0, bit1/0, a/0, i1/0, tuple/0, + b1/0, b2/0, ty_i1/0]). + +-export_type([o1/0, o2/0, d1/0, d2/0]). + +-export_type([i1/0, i2/0, di1/0, di2/0]). + +-export_type([ty_i1/0, c1/0, c2/0]). + +-export_type([b1/0, b2/0]). + +-export_type([bit1/0]). + +-export_type([tuple1/0, a/0, i/0]). + +%% Equal: + +-opaque o1() :: a | b | c. + +-opaque o2() :: a | b | c. + +%% Disjoint: + +-opaque d1() :: a | b | c. + +-opaque d2() :: d | e | f. + +%% One common element: + +-opaque c1() :: a | b | c. + +-opaque c2() :: c | e | f. + +%% Equal integer range: + +-opaque i1() :: 1 | 2. + +-opaque i2() :: 1 | 2. + +%% Disjoint integer range: + +-opaque di1() :: 1 | 2. + +-opaque di2() :: 3 | 4. + + +-type ty_i1() :: 1 | 2. + +%% Boolean types + +-opaque b1() :: boolean(). + +-opaque b2() :: boolean(). + +%% Binary types + +-opaque bit1() :: binary(). + +%% Tuple types + +-opaque tuple1() :: tuple(). + +%% Atom type + +-opaque a() :: atom(). + +-opaque i() :: integer(). + +-spec d1() -> d1(). + +d1() -> a. + +-spec d2() -> d2(). + +d2() -> d. + +-spec i() -> i(). + +i() -> + 1. + +-spec n1() -> o1(). + +n1() -> a. + +-spec n2() -> o2(). + +n2() -> a. + +-spec o1() -> o1(). + +o1() -> a. + +-spec o2() -> o2(). + +o2() -> a. + +-spec c1() -> c1(). + +c1() -> a. + +-spec c2() -> c2(). + +c2() -> e. + +-spec bit1() -> bit1(). + +bit1() -> + <<"hej">>. + +-spec a() -> a(). + +a() -> + e. + +-spec i1() -> i1(). + +i1() -> 1. + +-spec tuple() -> tuple1(). + +tuple() -> {1,2}. + +-spec b1() -> b1(). + +b1() -> true. + +-spec b2() -> b2(). + +b2() -> false. + +-spec ty_i1() -> ty_i1(). + +ty_i1() -> + 1. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_api.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_api.erl new file mode 100644 index 0000000000..d67aa913d8 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple1_api.erl @@ -0,0 +1,571 @@ +-module(simple1_api). + +-export([t1/1, adt_t1/1, t2/1, adt_t2/1, tup/0, t3/0, t4/0, t5/0, t6/0, t7/0, + t8/0, adt_t3/0, adt_t4/0, adt_t7/0, adt_t8/0, adt_t5/0, + c1/2, c2/2, c2/0, c3/0, c4/0, tt1/0, tt2/0, + cmp1/0, cmp2/0, cmp3/0, cmp4/0, + ty_cmp1/0, ty_cmp2/0, ty_cmp3/0, ty_cmp4/0, + f1/0, f2/0, adt_f1/0, adt_f2/0, f3/0, f4/0, adt_f3/0, adt_f4/0, + adt_f4_a/0, adt_f4_b/0, + bool_t1/0, bool_t2/0, bool_t3/0, bool_t4/0, bool_t5/1, bool_t6/1, + bool_t7/0, bool_adt_t1/0, bool_adt_t2/0, bool_adt_t5/1, + bool_adt_t6/1, bool_t8/0, bool_adt_t8/2, bool_t9/0, bool_adt_t9/2, + bit_t1/0, bit_adt_t1/0, bit_t3/1, bit_adt_t2/0, bit_adt_t3/1, + bit_t5/1, bit_t4/1, bit_adt_t4/1, bit_t5/0, bit_adt_t5/0, + call_f/1, call_f_adt/1, call_m_adt/1, call_m/1, call_f_i/1, + call_m_i/1, call_m_adt_i/1, call_f_adt_i/1, + eq1/0, eq2/0, c5/0, c6/2, c7/2, c8/0]). + +%%% Equal opaque types + +-export_type([o1/0, o2/0]). + +-export_type([d1/0, d2/0]). + +-opaque o1() :: a | b | c. + +-opaque o2() :: a | b | c. + +-export_type([i1/0, i2/0, di1/0, di2/0]). + +-export_type([b1/0, b2/0]). + +-export_type([bit1/0]). + +-export_type([a/0, i/0]). + +%% The derived spec is +%% -spec t1('a' | 'b') -> simple1_api:o1('a') | simple1_api:o2('a'). +%% but that is not tested... + +t1(a) -> + o1(); +t1(b) -> + o2(). + +-spec o1() -> o1(). + +o1() -> a. + +-spec o2() -> o2(). + +o2() -> a. + +%% The derived spec is +%% -spec adt_t1('a' | 'b') -> simple1_adt:o1('a') | simple1_adt:o2('a'). +%% but that is not tested... + +adt_t1(a) -> + simple1_adt:o1(); +adt_t1(b) -> + simple1_adt:o2(). + +%%% Disjunct opaque types + +-opaque d1() :: a | b | c. + +-opaque d2() :: d | e | f. + +%% -spec t2('a' | 'b') -> simple1_api:d1('a') | simple1_api:d2('d'). + +t2(a) -> + d1(); +t2(b) -> + d2(). + +-spec d1() -> d1(). + +d1() -> a. + +-spec d2() -> d2(). + +d2() -> d. + +%% -spec adt_t2('a' | 'b') -> simple1_adt:d1('a') | simple1_adt:d2('d'). + +adt_t2(a) -> + simple1_adt:d1(); +adt_t2(b) -> + simple1_adt:d2(). + +-spec tup() -> simple1_adt:tuple1(). % invalid type spec + +tup() -> + {a, b}. + +%%% Matching equal opaque types with different names + +t3() -> + A = n1(), + B = n2(), + A = A, % OK, of course + A = B. % OK since o1() and o2() are local opaque types + +t4() -> + A = n1(), + B = n2(), + true = A =:= A, % OK, of course + A =:= B. % OK since o1() and o2() are local opaque types + +t5() -> + A = d1(), + B = d2(), + A =:= B. % can never evaluate to true + +t6() -> + A = d1(), + B = d2(), + A = B. % can never succeed + +t7() -> + A = d1(), + B = d2(), + A =/= B. % OK (always true?) + +t8() -> + A = d1(), + B = d2(), + A /= B. % OK (always true?) + +-spec n1() -> o1(). + +n1() -> a. + +-spec n2() -> o2(). + +n2() -> a. + +adt_t3() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + true = A =:= A, % OK. + A =:= B. % opaque test, not OK + +adt_t4() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + A = A, % OK + A = B. % opaque terms + +adt_t7() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + false = A =/= A, % OK + A =/= B. % opaque test, not OK + +adt_t8() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + false = A /= A, % OK + A /= B. % opaque test, not OK + +adt_t5() -> + A = simple1_adt:c1(), + B = simple1_adt:c2(), + A =:= B. % opaque test, not OK + +%% Comparison in guard + +-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c1(A, B) when A =< B -> true. % succ type of A and B is any() (type spec is OK) + +-spec c2(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c2(A, B) -> + if A =< B -> true end. % succ type of A and B is any() (type spec is OK) + +c2() -> + A = simple1_adt:d1(), + B = simple1_adt:d2(), + if A =< B -> ok end. % opaque terms + +c3() -> + B = simple1_adt:d2(), + if a =< B -> ok end. % opaque term + +c4() -> + A = simple1_adt:d1(), + if A =< d -> ok end. % opaque term + +tt1() -> + A = o1(), + is_integer(A). % OK + +tt2() -> + A = simple1_adt:d1(), + is_integer(A). % breaks the opacity + +%% Comparison with integers + +-opaque i1() :: 1 | 2. + +-opaque i2() :: 1 | 2. + +-opaque di1() :: 1 | 2. + +-opaque di2() :: 3 | 4. + +-spec i1() -> i1(). + +i1() -> 1. + +-type ty_i1() :: 1 | 2. + +-spec ty_i1() -> ty_i1(). + +ty_i1() -> 1. + +cmp1() -> + A = i1(), + if A > 3 -> ok end. % can never succeed + +cmp2() -> + A = simple1_adt:i1(), + if A > 3 -> ok end. % opaque term + +cmp3() -> + A = i1(), + if A < 3 -> ok end. + +cmp4() -> + A = simple1_adt:i1(), + if A < 3 -> ok end. % opaque term + +%% -type + +ty_cmp1() -> + A = ty_i1(), + if A > 3 -> ok end. % can never succeed + +ty_cmp2() -> + A = simple1_adt:ty_i1(), + if A > 3 -> ok end. % can never succeed + +ty_cmp3() -> + A = ty_i1(), + if A < 3 -> ok end. + +ty_cmp4() -> + A = simple1_adt:ty_i1(), + if A < 3 -> ok end. + +%% is_function + +f1() -> + T = n1(), + if is_function(T) -> ok end. % can never succeed + +f2() -> + T = n1(), + is_function(T). % ok + +adt_f1() -> + T = simple1_adt:n1(), + if is_function(T) -> ok end. % breaks the opacity + +adt_f2() -> + T = simple1_adt:n1(), + is_function(T). % breaks the opacity + +f3() -> + A = i1(), + T = n1(), + if is_function(T, A) -> ok end. % can never succeed + +f4() -> + A = i1(), + T = n1(), + is_function(T, A). % ok + +adt_f3() -> + A = simple1_adt:i1(), + T = simple1_adt:n1(), + if is_function(T, A) -> ok end. % breaks the opacity + +adt_f4() -> + A = simple1_adt:i1(), + T = simple1_adt:n1(), + is_function(T, A). % breaks the opacity + +adt_f4_a() -> + A = simple1_adt:i1(), + T = n1(), + is_function(T, A). % opaque term + + +adt_f4_b() -> + A = i1(), + T = simple1_adt:n1(), + is_function(T, A). % breaks the opacity + +%% A few Boolean examples + +bool_t1() -> + B = b2(), + if B -> ok end. % B =:= true can never succeed + +bool_t2() -> + A = b1(), + B = b2(), + if A and not B -> ok end. + +bool_t3() -> + A = b1(), + if not A -> ok end. % can never succeed + +bool_t4() -> + A = n1(), + if not ((A >= 1) and not (A < 1)) -> ok end. % can never succeed + +-spec bool_t5(i1()) -> integer(). + +bool_t5(A) -> + if [not (A > 1)] =:= + [false]-> 1 end. + +-spec bool_t6(b1()) -> integer(). + +bool_t6(A) -> + if [not A] =:= + [false]-> 1 end. + +-spec bool_t7() -> integer(). + +bool_t7() -> + A = i1(), + if [not A] =:= % cannot succeed + [false]-> 1 end. + +bool_adt_t1() -> + B = simple1_adt:b2(), + if B -> ok end. % opaque term + +bool_adt_t2() -> + A = simple1_adt:b1(), + B = simple1_adt:b2(), + if A and not B -> ok end. % opaque term + +-spec bool_adt_t5(simple1_adt:i1()) -> integer(). + +bool_adt_t5(A) -> + if [not (A > 1)] =:= % succ type of A is any() (type spec is OK) + [false]-> 1 end. + +-spec bool_adt_t6(simple1_adt:b1()) -> integer(). % invalid type spec + +bool_adt_t6(A) -> + if [not A] =:= % succ type of A is 'true' + [false]-> 1 end. + +-spec bool_t8() -> integer(). + +bool_t8() -> + A = i1(), + if [A and A] =:= % cannot succeed + [false]-> 1 end. + +-spec bool_adt_t8(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid + +bool_adt_t8(A, B) -> + if [A and B] =:= + [false]-> 1 end. + +-spec bool_t9() -> integer(). + +bool_t9() -> + A = i1(), + if [A or A] =:= % cannot succeed + [false]-> 1 end. + +-spec bool_adt_t9(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid + +bool_adt_t9(A, B) -> + if [A or B] =:= + [false]-> 1 end. + +-opaque b1() :: boolean(). + +-opaque b2() :: boolean(). + +-spec b1() -> b1(). + +b1() -> true. + +-spec b2() -> b2(). + +b2() -> false. + +%% Few (very few...) examples with bit syntax + +bit_t1() -> + A = i1(), + <<100:(A)>>. + +bit_adt_t1() -> + A = simple1_adt:i1(), + <<100:(A)>>. % breaks the opacity + +bit_t3(A) -> + B = i1(), + case none:none() of + <<A:B>> -> 1 + end. + +bit_adt_t2() -> + A = simple1_adt:i1(), + case <<"hej">> of + <<_:A>> -> ok % breaks the opacity (but the message is strange) + end. + + +bit_adt_t3(A) -> + B = simple1_adt:i1(), + case none:none() of + <<A: % breaks the opacity (the message is less than perfect) + B>> -> 1 + end. + +bit_t5(A) -> + B = o1(), + case none:none() of % the type is any(); should fix that XXX + <<A:B>> -> 1 % can never match (local opaque type is OK) + end. + +-spec bit_t4(<<_:1>>) -> integer(). + +bit_t4(A) -> + Sz = i1(), + case A of + <<_:Sz>> -> 1 + end. + +-spec bit_adt_t4(<<_:1>>) -> integer(). + +bit_adt_t4(A) -> + Sz = simple1_adt:i1(), + case A of + <<_:Sz>> -> 1 % breaks the opacity + end. + +bit_t5() -> + A = bit1(), + case A of + <<_/binary>> -> 1 + end. + +bit_adt_t5() -> + A = simple1_adt:bit1(), + case A of + <<_/binary>> -> 1 % breaks the opacity + end. + +-opaque bit1() :: binary(). + +-spec bit1() -> bit1(). + +bit1() -> + <<"hej">>. + +%% Calls with variable module or function + +call_f(A) -> + A = a(), + foo:A(A). + +call_f_adt(A) -> + A = simple1_adt:a(), + foo:A(A). % breaks the opacity + +call_m(A) -> + A = a(), + A:foo(A). + +call_m_adt(A) -> + A = simple1_adt:a(), + A:foo(A). % breaks the opacity + +-opaque a() :: atom(). + +-opaque i() :: integer(). + +-spec a() -> a(). + +a() -> + e. + +call_f_i(A) -> + A = i(), + foo:A(A). % A is not atom() but i() + +call_f_adt_i(A) -> + A = simple1_adt:i(), + foo:A(A). % A is not atom() but simple1_adt:i() + +call_m_i(A) -> + A = i(), + A:foo(A). % A is not atom() but i() + +call_m_adt_i(A) -> + A = simple1_adt:i(), + A:foo(A). % A is not atom() but simple1_adt:i() + +-spec eq1() -> integer(). + +eq1() -> + A = simple1_adt:d2(), + B = simple1_adt:d1(), + if + A == B -> % opaque terms + 0; + A == A -> + 1; + A =:= A -> % compiler finds this one cannot match + 2; + true -> % compiler finds this one cannot match + 3 + end. + +eq2() -> + A = simple1_adt:d1(), + if + {A} >= {A} -> + 1; + A >= 3 -> % opaque term + 2; + A == 3 -> % opaque term + 3; + A =:= 3 -> % opaque term + 4; + A == A -> + 5; + A =:= A -> % compiler finds this one cannot match + 6 + end. + +c5() -> + A = simple1_adt:d1(), + A < 3. % opaque term + +c6(A, B) -> + A = simple1_adt:d1(), + B = simple1_adt:d1(), + A =< B. % same type - no warning + +c7(A, B) -> + A = simple1_adt:d1(), + B = simple1_adt:d2(), + A =< B. % opaque terms + +c8() -> + D = digraph:new(), + E = ets:new(foo, []), + if {D, a} > {D, E} -> true; % OK + {1.0, 2} > {{D}, {E}} -> true; % OK + {D, 3} > {D, E} -> true % opaque term 2 + end. + +-spec i() -> i(). + +i() -> + 1. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/simple/simple2_api.erl b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple2_api.erl new file mode 100644 index 0000000000..c86f6fd0b5 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/simple/simple2_api.erl @@ -0,0 +1,125 @@ +-module(simple2_api). + +-export([c1/2, c2/0, c3/0, c4/1, c5/1, c6/0, c6_b/0, c7/0, c7_b/0, + c7_c/0, c8/0, c9/0, c10/0, c11/0, c12/0, c13/0, c14/0, c15/0, + c16/0, c17/0, c18/0, c19/0, c20/0, c21/0, c22/0, c23/0, + c24/0, c25/0, c26/0]). + +-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c1(A, B) -> + {A} =< {B}. % succ type of A and B is any() + +c2() -> + A = simple1_adt:d1(), + erlang:make_tuple(1, A). % ok + +c3() -> + A = simple1_adt:d1(), + setelement(1, {A}, A). % ok + +c4(_) -> + A = simple1_adt:d1(), + halt(A). % ok (BIF fails...) + +c5(_) -> + A = simple1_adt:d1(), + [A] -- [A]. % ok + +c6() -> + A = simple1_adt:d1(), + A ! foo. % opaque term + +c6_b() -> + A = simple1_adt:d1(), + erlang:send(A, foo). % opaque term + +c7() -> + A = simple1_adt:d1(), + foo ! A. % ok + +c7_b() -> + A = simple1_adt:d1(), + erlang:send(foo, A). % ok + +c7_c() -> + A = simple1_adt:d1(), + erlang:send(foo, A, []). % ok + +c8() -> + A = simple1_adt:d1(), + A < 3. % opaque term + +c9() -> + A = simple1_adt:d1(), + lists:keysearch(A, 1, []). % ok + +c10() -> + A = simple1_adt:d1(), + lists:keysearch(1, A, []). % opaque term 2 + +c11() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [A]). % ok + +c12() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, A). % opaque term 3 + +c13() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [{A,2}]). % ok + +c14() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [{2,A}]). % ok + +c15() -> + A = simple1_adt:d1(), + lists:keysearch(key, 1, [A]). % ok + +c16() -> + A = simple1_adt:tuple(), + erlang:send(foo, A). % ok + +c17() -> + A = simple1_adt:tuple(), + lists:reverse([A]). % ok + +c18() -> + A = simple1_adt:tuple(), + lists:keyreplace(a, 1, [A], {1,2}). % ok + +c19() -> + A = simple1_adt:tuple(), + %% Problem. The spec says argument 4 is a tuple(). Fix that! + lists:keyreplace(a, 1, [{1,2}], A). % opaque term 4 + +c20() -> + A = simple1_adt:tuple(), + lists:flatten(A). % opaque term 1 + +c21() -> + A = simple1_adt:tuple(), + lists:flatten([[{A}]]). % ok + +c22() -> + A = simple1_adt:tuple(), + lists:flatten([[A]]). % ok + +c23() -> + A = simple1_adt:tuple(), + lists:flatten([A]). % ok + +c24() -> + A = simple1_adt:tuple(), + lists:flatten({A}). % will never return + +c25() -> + A = simple1_adt:d1(), + B = simple1_adt:tuple(), + if {A,3} > {A,B} -> true end. % opaque 2nd argument + +c26() -> + B = simple1_adt:tuple(), + tuple_to_list(B). % opaque term 1 diff --git a/lib/dialyzer/test/indent_SUITE_data/src/suppress_request.erl b/lib/dialyzer/test/indent_SUITE_data/src/suppress_request.erl new file mode 100644 index 0000000000..c4275fa110 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/suppress_request.erl @@ -0,0 +1,50 @@ +-module(suppress_request). + +-export([test1/1, test1_b/1, test2/0, test2_b/0, + test3/0, test3_b/0, test4/0, test4_b/0]). + +-dialyzer({[specdiffs], test1/1}). +-spec test1(a | b) -> ok. % spec is subtype +test1(A) -> + ok = test1_1(A). + +-spec test1_b(a | b) -> ok. % spec is subtype (suppressed by default) +test1_b(A) -> + ok = test1_1(A). + +-spec test1_1(a | b | c) -> ok. +test1_1(_) -> + ok. + +-dialyzer(unmatched_returns). +test2() -> + tuple(), % unmatched + ok. + +test2_b() -> + tuple(), % unmatched + ok. + +-dialyzer({[no_return, no_match], [test3/0]}). +test3() -> % no local return (suppressed) + A = fun(_) -> + 1 + end, + A = 2. % can never succeed (suppressed) + +test3_b() -> % no local return (requested by default) + A = fun(_) -> + 1 + end, + A = 2. % can never succeed (requested by default) + +-dialyzer(no_improper_lists). +test4() -> + [1 | 2]. % improper list (suppressed) + +-dialyzer({no_improper_lists, test4_b/0}). +test4_b() -> + [1 | 2]. % improper list (suppressed) + +tuple() -> + {a, b}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/trec.erl b/lib/dialyzer/test/indent_SUITE_data/src/trec.erl new file mode 100644 index 0000000000..516358f7c6 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/trec.erl @@ -0,0 +1,39 @@ +%% +%% The current treatment of typed records leaves much to be desired. +%% These are not made up examples; I have cases like that the branch +%% of the HiPE compiler with types in records. I get very confusing +%% warnings which require a lot of effort to find their cause and why +%% a function has no local return. +%% +-module(trec). +-export([test/0, mk_foo_exp/2]). + +-record(foo, {a :: integer() | 'undefined', b :: [atom()]}). + +%% +%% For these functions we currently get the following warnings: +%% 1. Function test/0 has no local return +%% 2. The call trec:mk_foo_loc(42,any()) will fail since it differs +%% in argument position 1 from the success typing arguments: +%% ('undefined',atom()) +%% 3. Function mk_foo_loc/2 has no local return +%% +%% Arguably, the second warning is not what most users have in mind when +%% they wrote the type declarations in the 'foo' record, so no doubt +%% they'll find it confusing. But note that it is also quite confusing! +%% Many users may be wondering: How come there is a success typing for a +%% function that has no local return? Running typer on this module +%% reveals a success typing for this function that is interesting indeed. +%% +test() -> + mk_foo_loc(42, some_mod:some_function()). + +mk_foo_loc(A, B) -> + #foo{a = A, b = [A,B]}. + +%% +%% For this function we used to get a "has no local return" warning +%% but we got no reason. This has now been fixed. +%% +mk_foo_exp(A, B) when is_integer(A) -> + #foo{a = A, b = [A,B]}. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/whereis_control_flow1.erl b/lib/dialyzer/test/indent_SUITE_data/src/whereis_control_flow1.erl new file mode 100644 index 0000000000..e65f6c3e23 --- /dev/null +++ b/lib/dialyzer/test/indent_SUITE_data/src/whereis_control_flow1.erl @@ -0,0 +1,17 @@ +%% This tests the presence of possible races due to a whereis/register +%% combination. It takes into account control flow that might exist. + +-module(whereis_control_flow1). +-export([start/2]). + +start(AnAtom, Fun) -> + case whereis(AnAtom) of + undefined -> + Pid = spawn(Fun), + case Pid =:= self() of + true -> ok; + false -> register(AnAtom, Pid) + end; + P when is_pid(P) -> + ok + end. diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options index 02425c33f2..1ddeb02c27 100644 --- a/lib/dialyzer/test/map_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, []}. +{dialyzer_options, [{indent_opt, false}]}. {time_limit, 30}. diff --git a/lib/dialyzer/test/map_SUITE_data/results/contract b/lib/dialyzer/test/map_SUITE_data/results/contract index 0f6e1d0c65..620ec8e6b1 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/contract +++ b/lib/dialyzer/test/map_SUITE_data/results/contract @@ -1,7 +1,7 @@ contract.erl:10: Function t2/0 has no local return -contract.erl:10: The call missing:f(#{'a':=1, 'c':=4}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:10: The call missing:f(#{'a'=>1, 'c'=>4}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' contract.erl:12: Function t3/0 has no local return -contract.erl:12: The call missing:f(#{'a':=1, 'b':=2, 'e':=3}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:12: The call missing:f(#{'a'=>1, 'b'=>2, 'e'=>3}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' contract.erl:8: Function t1/0 has no local return -contract.erl:8: The call missing:f(#{'b':=2}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:8: The call missing:f(#{'b'=>2}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' diff --git a/lib/dialyzer/test/map_SUITE_data/results/guard_update b/lib/dialyzer/test/map_SUITE_data/results/guard_update index 98df23907f..f6de2158fc 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/guard_update +++ b/lib/dialyzer/test/map_SUITE_data/results/guard_update @@ -1,5 +1,5 @@ guard_update.erl:5: Function t/0 has no local return -guard_update.erl:6: The call guard_update:f(#{'a':=2}) will never return since it differs in the 1st argument from the success typing arguments: (#{'b':=_, _=>_}) +guard_update.erl:6: The call guard_update:f(#{'a'=>2}) will never return since it differs in the 1st argument from the success typing arguments: (#{'b':=_, _=>_}) guard_update.erl:8: Clause guard cannot succeed. The variable M was matched against the type #{'a':=2} guard_update.erl:8: Function f/1 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_galore b/lib/dialyzer/test/map_SUITE_data/results/map_galore index 9a140de255..6d1f4ff2bf 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/map_galore +++ b/lib/dialyzer/test/map_SUITE_data/results/map_galore @@ -2,11 +2,11 @@ map_galore.erl:1000: A key of type 42 cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c' | 'v'} map_galore.erl:1080: A key of type 'nonexisting' cannot exist in a map of type #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} map_galore.erl:1082: A key of type 42 cannot exist in a map of type #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} -map_galore.erl:1140: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) -map_galore.erl:1141: The call map_galore:map_guard_sequence_2(#{'b':=5}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1140: The call map_galore:map_guard_sequence_1(#{'seq'=>6, 'val'=>"e"}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1141: The call map_galore:map_guard_sequence_2(#{'b'=>5}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) map_galore.erl:1209: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) map_galore.erl:1210: The call map_galore:map_guard_sequence_2(#{'b':=5, 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 'map'=>'key', 'one'=>'small', 'second'=>'small', 'third'=>'small', 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[any(),...], 31=>[any(),...], 32=>[any(),...], 33=>[any(),...], 34=>[any(),...], 35=>[any(),...], 36=>[any(),...], 37=>[any(),...], 38=>[any(),...], 39=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) -map_galore.erl:1418: Fun application with arguments (#{'s':='none', 'v':='none'}) will never return since it differs in the 1st argument from the success typing arguments: (#{'s':='l' | 't' | 'v', 'v':='none' | <<_:16>> | [<<_:16>>,...] | {<<_:16>>,<<_:16>>}}) +map_galore.erl:1418: Fun application with arguments (#{'s'=>'none', 'v'=>'none'}) will never return since it differs in the 1st argument from the success typing arguments: (#{'s':='l' | 't' | 'v', 'v':='none' | <<_:16>> | [<<_:16>>,...] | {<<_:16>>,<<_:16>>}}) map_galore.erl:1491: The test #{} =:= #{'a':=1} can never evaluate to 'true' map_galore.erl:1492: The test #{'a':=1} =:= #{} can never evaluate to 'true' map_galore.erl:1495: The test #{'a':=1} =:= #{'a':=2} can never evaluate to 'true' @@ -15,13 +15,13 @@ map_galore.erl:1497: The test #{'a':=2, 'b':=1} =:= #{'a':=1, 'b':=3} can never map_galore.erl:1498: The test #{'a':=1, 'b':=1} =:= #{'a':=1, 'b':=3} can never evaluate to 'true' map_galore.erl:1762: The call maps:get({1, 1},#{{1,float()}=>[101 | 108 | 112 | 116 | 117,...]}) will never return since the success typing arguments are (any(),map()) map_galore.erl:1763: The call maps:get('a',#{}) will never return since the success typing arguments are (any(),map()) -map_galore.erl:1765: The call maps:get('a',#{'b':=1, 'c':=2}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:1765: The call maps:get('a',#{'b'=>1, 'c'=>2}) will never return since the success typing arguments are (any(),map()) map_galore.erl:186: The pattern #{'x':=2} can never match the type #{'x':=3} map_galore.erl:187: The pattern #{'x':=3} can never match the type {'a','b','c'} map_galore.erl:188: The pattern #{'x':=3} can never match the type #{'y':=3} map_galore.erl:189: The pattern #{'x':=3} can never match the type #{'x':=[101 | 104 | 114 | 116,...]} map_galore.erl:2280: Cons will produce an improper list since its 2nd argument is {'b','a'} -map_galore.erl:2280: The call maps:from_list(nonempty_improper_list({'a','b'},{'b','a'})) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2280: The call maps:from_list([{'a', 'b'} | {'b', 'a'}]) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:2281: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:2282: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:997: A key of type 'nonexisting' cannot exist in a map of type #{} diff --git a/lib/dialyzer/test/map_SUITE_data/results/typesig b/lib/dialyzer/test/map_SUITE_data/results/typesig index fb2f851a7d..6a79fe35f1 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/typesig +++ b/lib/dialyzer/test/map_SUITE_data/results/typesig @@ -1,5 +1,5 @@ typesig.erl:5: Function t1/0 has no local return -typesig.erl:5: The call typesig:test(#{'a':=1}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, _=>_}) +typesig.erl:5: The call typesig:test(#{'a'=>1}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, _=>_}) typesig.erl:6: Function t2/0 has no local return typesig.erl:6: The call typesig:test(#{'a':={'b'}}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, _=>_}) diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options index cb301ff6a1..8551a47541 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{warnings, [no_unused, no_return]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [no_unused, no_return]}]}. {time_limit, 40}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/dict b/lib/dialyzer/test/opaque_SUITE_data/results/dict index 3f8242c72d..bda9bfc09f 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/dict +++ b/lib/dialyzer/test/opaque_SUITE_data/results/dict @@ -10,6 +10,6 @@ dict_use.erl:64: Guard test length(D::dict:dict(_,_)) breaks the opacity of its dict_use.erl:65: Guard test is_atom(D::dict:dict(_,_)) breaks the opacity of its argument dict_use.erl:66: Guard test is_list(D::dict:dict(_,_)) breaks the opacity of its argument dict_use.erl:70: The type test is_list(dict:dict(_,_)) breaks the opacity of the term dict:dict(_,_) -dict_use.erl:73: The call dict:fetch('foo',[1 | 2 | 3,...]) does not have an opaque term of type dict:dict(_,_) as 2nd argument -dict_use.erl:76: The call dict:merge(Fun::any(),42,[1 | 2,...]) does not have opaque terms as 2nd and 3rd arguments -dict_use.erl:79: The call dict:store(42,'elli',{'dict',0,16,16,8,80,48,{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]},{{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}) does not have an opaque term of type dict:dict(_,_) as 3rd argument +dict_use.erl:73: The call dict:fetch('foo',[1, 2, 3]) does not have an opaque term of type dict:dict(_,_) as 2nd argument +dict_use.erl:76: The call dict:merge(Fun::any(),42,[1, 2]) does not have opaque terms as 2nd and 3rd arguments +dict_use.erl:79: The call dict:store(42,'elli',{'dict', 0, 16, 16, 8, 80, 48, {[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []}, {{[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []}}}) does not have an opaque term of type dict:dict(_,_) as 3rd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/queue b/lib/dialyzer/test/opaque_SUITE_data/results/queue index 9822b7168f..8f9373e8e4 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/queue +++ b/lib/dialyzer/test/opaque_SUITE_data/results/queue @@ -1,11 +1,11 @@ -queue_use.erl:18: The call queue:is_empty({[],[]}) does not have an opaque term of type queue:queue(_) as 1st argument +queue_use.erl:18: The call queue:is_empty({[], []}) does not have an opaque term of type queue:queue(_) as 1st argument queue_use.erl:22: The call queue:in(42,Q0::{[],[]}) does not have an opaque term of type queue:queue(_) as 2nd argument queue_use.erl:27: The attempt to match a term of type queue:queue(_) against the pattern {"*", Q2} breaks the opacity of the term queue_use.erl:33: Attempt to test for equality between a term of type {[42,...],[]} and a term of opaque type queue:queue(_) queue_use.erl:36: The attempt to match a term of type queue:queue(_) against the pattern {F, _R} breaks the opacity of the term -queue_use.erl:40: The call queue:out({[42,...],[]}) does not have an opaque term of type queue:queue(_) as 1st argument +queue_use.erl:40: The call queue:out({"*", []}) does not have an opaque term of type queue:queue(_) as 1st argument queue_use.erl:51: The call queue_use:is_in_queue(E::42,DB::#db{p::[],q::queue:queue(_)}) contains an opaque term as 2nd argument when terms of different types are expected in these positions queue_use.erl:56: The attempt to match a term of type #db{p::[],q::queue:queue(_)} against the pattern {'db', _, {L1, L2}} breaks the opacity of queue:queue(_) -queue_use.erl:62: The call queue_use:tuple_queue({42,'gazonk'}) does not have a term of type {_,queue:queue(_)} (with opaque subterms) as 1st argument +queue_use.erl:62: The call queue_use:tuple_queue({42, 'gazonk'}) does not have a term of type {_,queue:queue(_)} (with opaque subterms) as 1st argument queue_use.erl:65: The call queue:in(F::42,Q::'gazonk') does not have an opaque term of type queue:queue(_) as 2nd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 5cd8916aee..5d13b56970 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -51,7 +51,7 @@ simple1_api.erl:294: The call erlang:is_function(T::simple1_api:o1(),A::simple1_ simple1_api.erl:300: The type test is_function(T::simple1_adt:o1(),A::simple1_api:i1()) breaks the opacity of the term T::simple1_adt:o1() simple1_api.erl:306: Guard test B::simple1_api:b2() =:= 'true' can never succeed simple1_api.erl:315: Guard test A::simple1_api:b1() =:= 'false' can never succeed -simple1_api.erl:319: Guard test not('and'('true','true')) can never succeed +simple1_api.erl:319: Guard test not(and('true','true')) can never succeed simple1_api.erl:337: Clause guard cannot succeed. simple1_api.erl:342: Guard test B::simple1_adt:b2() =:= 'true' contains an opaque term as 1st argument simple1_api.erl:347: Guard test A::simple1_adt:b1() =:= 'true' contains an opaque term as 1st argument @@ -63,9 +63,9 @@ simple1_api.erl:381: Invalid type specification for function simple1_api:bool_ad simple1_api.erl:407: The size simple1_adt:i1() breaks the opacity of A simple1_api.erl:418: The attempt to match a term of type non_neg_integer() against the variable A breaks the opacity of simple1_adt:i1() simple1_api.erl:425: The attempt to match a term of type non_neg_integer() against the variable B breaks the opacity of simple1_adt:i1() -simple1_api.erl:432: The pattern <<_:B/integer-unit:1>> can never match the type any() +simple1_api.erl:432: The pattern <<_:B>> can never match the type any() simple1_api.erl:448: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opacity of simple1_adt:i1() -simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary-unit:8>> breaks the opacity of the term +simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary>> breaks the opacity of the term simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() diff --git a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options index c612e77d3e..ef5887a1eb 100644 --- a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists]}]}. +{dialyzer_options, [{indent_opt, false}, {include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists]}]}. {time_limit, 30}. diff --git a/lib/dialyzer/test/options1_SUITE_data/results/compiler b/lib/dialyzer/test/options1_SUITE_data/results/compiler index e1dc038800..121163d7ca 100644 --- a/lib/dialyzer/test/options1_SUITE_data/results/compiler +++ b/lib/dialyzer/test/options1_SUITE_data/results/compiler @@ -6,8 +6,8 @@ beam_disasm.erl:537: The variable X can never match since previous clauses compl beam_type.erl:284: The pattern <'pi', 0> can never match the type <_,1 | 2> beam_validator.erl:396: Matching of pattern {'vst', 'none', _} tagged with a record name violates the declared type of #vst{current::#st{ct::[]}} beam_validator.erl:690: The pattern <'term', OldT> can never match the type <{'tuple',[any(),...]},_> -beam_validator.erl:693: Guard test 'or'('false','false') can never succeed -beam_validator.erl:700: Guard test 'or'('false','false') can never succeed +beam_validator.erl:693: Guard test or('false','false') can never succeed +beam_validator.erl:700: Guard test or('false','false') can never succeed beam_validator.erl:702: The pattern <'number', OldT = {Type, _}> can never match the type <{'tuple',[any(),...]},_> beam_validator.erl:705: The pattern <'bool', {'atom', A}> can never match the type <{'tuple',[any(),...]},_> beam_validator.erl:707: The pattern <{'atom', A}, 'bool'> can never match the type <{'tuple',[any(),...]},_> diff --git a/lib/dialyzer/test/options2_SUITE_data/dialyzer_options b/lib/dialyzer/test/options2_SUITE_data/dialyzer_options index be57e2de72..6492098d01 100644 --- a/lib/dialyzer/test/options2_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/options2_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{defines, [{'vsn', 4}]}, {warnings, [unknown, no_return]}]}. +{dialyzer_options, [{indent_opt, false}, {defines, [{'vsn', 4}]}, {warnings, [unknown, no_return]}]}. diff --git a/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options b/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options index ff4517e59d..f581ad6607 100644 --- a/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [overspecs]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [overspecs]}]}. diff --git a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options index e00e23bb66..ab6c9439ad 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{defines, [{vsn, 42}]}]}. +{dialyzer_options, [{indent_opt, false}, {defines, [{vsn, 42}]}]}. {time_limit, 20}. diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 index 1cf03346ee..6e51b972af 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 +++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 @@ -87,7 +87,7 @@ asn1rt_per_bin.erl:2127: Cons will produce an improper list since its 2nd argume asn1rt_per_bin.erl:2129: Cons will produce an improper list since its 2nd argument is integer() asn1rt_per_bin.erl:446: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin.erl:467: The variable _ can never match since previous clauses completely covered the type integer() -asn1rt_per_bin.erl:474: The pattern <{_N, <<_:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> +asn1rt_per_bin.erl:474: The pattern <{_N, <<_,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> asn1rt_per_bin.erl:487: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin.erl:498: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:152: The call asn1rt_per_bin_rt2ct:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>}) @@ -95,7 +95,7 @@ asn1rt_per_bin_rt2ct.erl:1533: The pattern {'BMPString', {'octets', Ol}} can nev asn1rt_per_bin_rt2ct.erl:1875: The pattern {Name, Val} can never match since previous clauses completely covered the type any() asn1rt_per_bin_rt2ct.erl:443: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:464: The variable _ can never match since previous clauses completely covered the type integer() -asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> +asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> asn1rt_per_bin_rt2ct.erl:484: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:495: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_v1.erl:1209: The pattern <_, 'true', _> can never match the type <_,'false',_> diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index d377f34978..31e9f031ce 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -21,9 +21,9 @@ httpd_manager.erl:885: The pattern {'EXIT', Reason} can never match since previo httpd_manager.erl:919: Function auth_status/1 will never be called httpd_manager.erl:926: Function sec_status/1 will never be called httpd_manager.erl:933: Function acceptor_status/1 will never be called -httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 66 | 98 | 100 | 103 | 105 | 111 | 116 | 121,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,"Body to big") will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,"Method not allowed") will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,"Method not allowed") will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) httpd_request_handler.erl:649: Guard test [{_,_}] =:= Trailers::nonempty_string() can never succeed httpd_sup.erl:63: The variable Else can never match since previous clauses completely covered the type {'error',_} | {'ok',[any()],_,_} httpd_sup.erl:88: The pattern {'error', Reason} can never match the type {'ok',_,_} diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl index a997db6880..53eeedc29f 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl @@ -71,7 +71,7 @@ do_responsecontrol(Info) -> %% If a client sends more then one of the if-XXXX fields in a request -%% The standard says it does not specify the behaviuor so I specified it :-) +%% The standard says it does not specify the behaviour so I specified it :-) %% The priority between the fields is %% 1.If-modified %% 2.If-Unmodified diff --git a/lib/dialyzer/test/race_SUITE_data/dialyzer_options b/lib/dialyzer/test/race_SUITE_data/dialyzer_options index 44e1720715..2be2f47dda 100644 --- a/lib/dialyzer/test/race_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/race_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [race_conditions]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [race_conditions]}]}. diff --git a/lib/dialyzer/test/race_SUITE_data/results/ets_insert_double1 b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_double1 index b640b91271..2473bf5d01 100644 --- a/lib/dialyzer/test/race_SUITE_data/results/ets_insert_double1 +++ b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_double1 @@ -1,4 +1,4 @@ ets_insert_double1.erl:15: The call ets:insert('foo',[{'pass',[number()]} | {'random',integer()},...]) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('foo','random') call in ets_insert_double1.erl on line 10, the ets:lookup('foo','pass') call in ets_insert_double1.erl on line 27 ets_insert_double1.erl:19: The call ets:insert('foo',[{'pass',[number()]} | {'random',integer()},...]) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('foo','random') call in ets_insert_double1.erl on line 10, the ets:lookup('foo','pass') call in ets_insert_double1.erl on line 27 -ets_insert_double1.erl:24: The call ets:insert('foo',{'pass','empty'}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('foo','pass') call in ets_insert_double1.erl on line 22 +ets_insert_double1.erl:24: The call ets:insert('foo',{'pass', 'empty'}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('foo','pass') call in ets_insert_double1.erl on line 22 diff --git a/lib/dialyzer/test/small_SUITE_data/dialyzer_options b/lib/dialyzer/test/small_SUITE_data/dialyzer_options index 50991c9bc5..8413436b67 100644 --- a/lib/dialyzer/test/small_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/small_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, []}. +{dialyzer_options, [{indent_opt, false}]}. diff --git a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr index dbc8241971..797f83956d 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr +++ b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr @@ -1,9 +1,9 @@ bs_fail_constr.erl:11: Function w3/1 has no local return -bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S/integer-unit:1 has type neg_integer() +bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S has type neg_integer() bs_fail_constr.erl:14: Function w4/1 has no local return bs_fail_constr.erl:15: Binary construction will fail since the value field V in segment V/utf32 has type float() bs_fail_constr.erl:5: Function w1/1 has no local return -bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V:8/integer-unit:1 has type float() +bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V has type float() bs_fail_constr.erl:8: Function w2/1 has no local return -bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary-unit:8 has type atom() +bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary has type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars index 72fbdb4528..02797f2a59 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/chars +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -1,4 +1,4 @@ chars.erl:37: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' chars.erl:40: Function t1/0 has no local return -chars.erl:40: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' +chars.erl:40: The call chars:f(#{'b'=>50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index d2a3ebb766..04336f43aa 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -1,15 +1,15 @@ -contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} -contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} -contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} -contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() -contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a', 'b'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b', 'a'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b', {'a', 'b'}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a', 'b'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b', 'a'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a', {'b', 'a'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b', {'a', 'b'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a', {'b', {'a', 'b'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b', {'a', {'b', 'a'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a', {'b', {'a', {'b', 'a'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b', {'a', {'b', {'a', 'b'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() contracts_with_subtypes.erl:175: The pattern 1 can never match the type string() contracts_with_subtypes.erl:178: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} contracts_with_subtypes.erl:180: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 index 1a8aeb13d0..6d611db568 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 @@ -1,3 +1,3 @@ contracts_with_subtypes2.erl:18: Function t/0 has no local return -contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A}, A :: {'b',B}, B :: {'c',C}, C :: {'d',D}, D :: {'e',E}, E :: {'f',_} +contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a', {'b', {'c', {'d', {'e', {'g', 3}}}}}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A}, A :: {'b',B}, B :: {'c',C}, C :: {'d',D}, D :: {'e',E}, E :: {'f',_} diff --git a/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 b/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 index 5bdd13093a..09fe076a6f 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 +++ b/lib/dialyzer/test/small_SUITE_data/results/failing_guard1 @@ -1,4 +1,4 @@ failing_guard1.erl:12: Guard test float() =:= 2 can never succeed -failing_guard1.erl:13: Guard test integer() =:= float() can never succeed -failing_guard1.erl:14: Guard test -2 | -1 | 0 | 1 | 2 =:= float() can never succeed +failing_guard1.erl:13: Guard test integer() =:= 2.0 can never succeed +failing_guard1.erl:14: Guard test -2 | -1 | 0 | 1 | 2 =:= 2.0 can never succeed diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_app_args b/lib/dialyzer/test/small_SUITE_data/results/fun_app_args new file mode 100644 index 0000000000..ac153a6fb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_app_args @@ -0,0 +1,3 @@ + +fun_app_args.erl:12: Fun application with arguments ('b',[]) will fail since the function has type 'c' | fun(('a',[]) -> any()), which differs in the 1st argument +fun_app_args.erl:12: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/guard_warnings b/lib/dialyzer/test/small_SUITE_data/results/guard_warnings index 0ff998bf50..14b7a9052c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/guard_warnings +++ b/lib/dialyzer/test/small_SUITE_data/results/guard_warnings @@ -1,6 +1,6 @@ guard_warnings.erl:100: Function test45/0 has no local return -guard_warnings.erl:100: Guard test 'not'('true') can never succeed +guard_warnings.erl:100: Guard test not('true') can never succeed guard_warnings.erl:102: Function test46/1 has no local return guard_warnings.erl:102: Guard test X::'true' =:= 'false' can never succeed guard_warnings.erl:104: Function test47/1 has no local return @@ -14,79 +14,79 @@ guard_warnings.erl:12: Guard test X::'true' =:= 'false' can never succeed guard_warnings.erl:14: Function test2/1 has no local return guard_warnings.erl:14: Guard test X::'false' =:= 'true' can never succeed guard_warnings.erl:16: Function test3/1 has no local return -guard_warnings.erl:16: Guard test 'not'(X::'true') can never succeed +guard_warnings.erl:16: Guard test not(X::'true') can never succeed guard_warnings.erl:18: Function test4/1 has no local return -guard_warnings.erl:18: Guard test 'and'('true',X::none()) can never succeed +guard_warnings.erl:18: Guard test and('true',X::none()) can never succeed guard_warnings.erl:20: Function test5/1 has no local return -guard_warnings.erl:20: Guard test 'not'(X::'true') can never succeed +guard_warnings.erl:20: Guard test not(X::'true') can never succeed guard_warnings.erl:22: Function test6/1 has no local return -guard_warnings.erl:22: Guard test 'and'('true',X::none()) can never succeed +guard_warnings.erl:22: Guard test and('true',X::none()) can never succeed guard_warnings.erl:24: Function test7_w/1 has no local return guard_warnings.erl:26: Function test8_w/1 has no local return guard_warnings.erl:28: Function test9/1 has no local return -guard_warnings.erl:28: Guard test not('not'(X::'false')) can never succeed +guard_warnings.erl:28: Guard test not(not(X::'false')) can never succeed guard_warnings.erl:30: Function test10/1 has no local return -guard_warnings.erl:30: Guard test not('or'('false',X::none())) can never succeed +guard_warnings.erl:30: Guard test not(or('false',X::none())) can never succeed guard_warnings.erl:32: Function test11/1 has no local return -guard_warnings.erl:32: Guard test not('not'(X::'false')) can never succeed +guard_warnings.erl:32: Guard test not(not(X::'false')) can never succeed guard_warnings.erl:34: Function test12/1 has no local return -guard_warnings.erl:34: Guard test not('or'('false',X::none())) can never succeed +guard_warnings.erl:34: Guard test not(or('false',X::none())) can never succeed guard_warnings.erl:36: Function test13/1 has no local return -guard_warnings.erl:36: Guard test 'and'('true','false') can never succeed +guard_warnings.erl:36: Guard test and('true','false') can never succeed guard_warnings.erl:38: Function test14/1 has no local return -guard_warnings.erl:38: Guard test 'and'('false',any()) can never succeed +guard_warnings.erl:38: Guard test and('false',any()) can never succeed guard_warnings.erl:40: Function test15/1 has no local return -guard_warnings.erl:40: Guard test 'and'(X::'true','false') can never succeed +guard_warnings.erl:40: Guard test and(X::'true','false') can never succeed guard_warnings.erl:42: Function test16/1 has no local return -guard_warnings.erl:42: Guard test 'and'('false',X::any()) can never succeed +guard_warnings.erl:42: Guard test and('false',X::any()) can never succeed guard_warnings.erl:44: Function test17/1 has no local return -guard_warnings.erl:44: Guard test 'and'(X::'true','false') can never succeed +guard_warnings.erl:44: Guard test and(X::'true','false') can never succeed guard_warnings.erl:46: Function test18/1 has no local return -guard_warnings.erl:46: Guard test 'and'('false',X::any()) can never succeed +guard_warnings.erl:46: Guard test and('false',X::any()) can never succeed guard_warnings.erl:48: Function test19/1 has no local return -guard_warnings.erl:48: Guard test not('or'('true',any())) can never succeed +guard_warnings.erl:48: Guard test not(or('true',any())) can never succeed guard_warnings.erl:50: Function test20/1 has no local return -guard_warnings.erl:50: Guard test not('or'('false','true')) can never succeed +guard_warnings.erl:50: Guard test not(or('false','true')) can never succeed guard_warnings.erl:52: Function test21/1 has no local return -guard_warnings.erl:52: Guard test not('or'('true',X::any())) can never succeed +guard_warnings.erl:52: Guard test not(or('true',X::any())) can never succeed guard_warnings.erl:54: Function test22/1 has no local return -guard_warnings.erl:54: Guard test not('or'(X::'false','true')) can never succeed +guard_warnings.erl:54: Guard test not(or(X::'false','true')) can never succeed guard_warnings.erl:56: Function test23/1 has no local return -guard_warnings.erl:56: Guard test not('or'('true',X::any())) can never succeed +guard_warnings.erl:56: Guard test not(or('true',X::any())) can never succeed guard_warnings.erl:58: Function test24/1 has no local return -guard_warnings.erl:58: Guard test not('or'(X::'false','true')) can never succeed +guard_warnings.erl:58: Guard test not(or(X::'false','true')) can never succeed guard_warnings.erl:60: Function test25/1 has no local return -guard_warnings.erl:60: Guard test 'and'('false',any()) can never succeed +guard_warnings.erl:60: Guard test and('false',any()) can never succeed guard_warnings.erl:62: Function test26/1 has no local return -guard_warnings.erl:62: Guard test 'and'('true','false') can never succeed +guard_warnings.erl:62: Guard test and('true','false') can never succeed guard_warnings.erl:64: Function test27/1 has no local return -guard_warnings.erl:64: Guard test 'and'('false',X::any()) can never succeed +guard_warnings.erl:64: Guard test and('false',X::any()) can never succeed guard_warnings.erl:66: Function test28/1 has no local return -guard_warnings.erl:66: Guard test 'and'(X::'true','false') can never succeed +guard_warnings.erl:66: Guard test and(X::'true','false') can never succeed guard_warnings.erl:68: Function test29/1 has no local return -guard_warnings.erl:68: Guard test 'and'('false',X::any()) can never succeed +guard_warnings.erl:68: Guard test and('false',X::any()) can never succeed guard_warnings.erl:70: Function test30/1 has no local return -guard_warnings.erl:70: Guard test 'and'(X::'true','false') can never succeed +guard_warnings.erl:70: Guard test and(X::'true','false') can never succeed guard_warnings.erl:72: Function test31/0 has no local return -guard_warnings.erl:72: Guard test 'and'('false',any()) can never succeed +guard_warnings.erl:72: Guard test and('false','false') can never succeed guard_warnings.erl:74: Function test32/0 has no local return -guard_warnings.erl:74: Guard test 'and'('false',any()) can never succeed +guard_warnings.erl:74: Guard test and('false','false') can never succeed guard_warnings.erl:76: Function test33/0 has no local return -guard_warnings.erl:76: Guard test not('and'('true','true')) can never succeed +guard_warnings.erl:76: Guard test not(and('true','true')) can never succeed guard_warnings.erl:78: Function test34/0 has no local return -guard_warnings.erl:78: Guard test 'and'('false',any()) can never succeed +guard_warnings.erl:78: Guard test and('false','false') can never succeed guard_warnings.erl:80: Function test35/0 has no local return -guard_warnings.erl:80: Guard test not('and'('true','true')) can never succeed +guard_warnings.erl:80: Guard test not(and('true','true')) can never succeed guard_warnings.erl:82: Function test36/0 has no local return -guard_warnings.erl:82: Guard test 'or'('false','false') can never succeed +guard_warnings.erl:82: Guard test or('false','false') can never succeed guard_warnings.erl:84: Function test37/0 has no local return -guard_warnings.erl:84: Guard test 'or'('false','false') can never succeed +guard_warnings.erl:84: Guard test or('false','false') can never succeed guard_warnings.erl:86: Function test38/0 has no local return -guard_warnings.erl:86: Guard test 'or'('false','false') can never succeed +guard_warnings.erl:86: Guard test or('false','false') can never succeed guard_warnings.erl:88: Function test39/0 has no local return -guard_warnings.erl:88: Guard test 'or'('false','false') can never succeed +guard_warnings.erl:88: Guard test or('false','false') can never succeed guard_warnings.erl:90: Function test40/0 has no local return -guard_warnings.erl:90: Guard test 'or'('false','false') can never succeed +guard_warnings.erl:90: Guard test or('false','false') can never succeed guard_warnings.erl:92: Function test41/0 has no local return guard_warnings.erl:92: Guard test 'true' =:= 'false' can never succeed guard_warnings.erl:94: Function test42/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring index e148e5cf22..dc3620fcf0 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring +++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring @@ -1,3 +1,3 @@ pretty_bitstring.erl:7: Function t/0 has no local return -pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() +pretty_bitstring.erl:8: The call binary:copy(<<1,2,3:3>>,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() diff --git a/lib/dialyzer/test/small_SUITE_data/results/spec_other_module b/lib/dialyzer/test/small_SUITE_data/results/spec_other_module deleted file mode 100644 index ab2e35cf55..0000000000 --- a/lib/dialyzer/test/small_SUITE_data/results/spec_other_module +++ /dev/null @@ -1,2 +0,0 @@ - -spec_other_module.erl:7: Contract for function that does not exist: lists:flatten/1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash index 8c9df56a4b..7fd1f304cb 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash +++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash @@ -3,12 +3,12 @@ tuple_set_crash.erl:103: Invalid type specification for function tuple_set_crash tuple_set_crash.erl:123: Invalid type specification for function tuple_set_crash:parse_video_target_info/1. The success typing is (<<_:48>>) -> [{'status',byte()} | {'target_id',non_neg_integer()},...] tuple_set_crash.erl:127: Invalid type specification for function tuple_set_crash:parse_audio_target_info/1. The success typing is (<<_:48>>) -> [{'master_volume',char()} | {'status',byte()} | {'target_id',non_neg_integer()},...] tuple_set_crash.erl:138: Invalid type specification for function tuple_set_crash:parse_av_device_info/1. The success typing is (<<_:48>>) -> [{'address',byte()} | {'device_id',non_neg_integer()} | {'model',binary()} | {'status',byte()},...] -tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> tuple_set_crash.erl:155: Invalid type specification for function tuple_set_crash:parse_video_output_info/1. The success typing is (<<_:48>>) -> [{'audio_volume',char()} | {'display_type',binary()} | {'output_id',non_neg_integer()},...] -tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> tuple_set_crash.erl:171: Invalid type specification for function tuple_set_crash:parse_audio_output_info/1. The success typing is (<<_:48>>) -> [{'output_id',non_neg_integer()},...] -tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> -tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary-unit:8>> can never match the type <<_:8>> -tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> +tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary>> can never match the type <<_:8>> +tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary>> can never match the type <<_:8>> tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} diff --git a/lib/dialyzer/test/small_SUITE_data/results/union_paren b/lib/dialyzer/test/small_SUITE_data/results/union_paren new file mode 100644 index 0000000000..3a3526df89 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/union_paren @@ -0,0 +1,7 @@ + +union_paren.erl:12: Function t2/0 has no local return +union_paren.erl:13: The call union_paren:t2(3.14) breaks the contract (integer() | atom()) -> integer() +union_paren.erl:19: Function t3/0 has no local return +union_paren.erl:20: The pattern 3.14 can never match the type atom() | integer() +union_paren.erl:5: Function t1/0 has no local return +union_paren.erl:6: The call union_paren:t1(3.14) breaks the contract ((A::integer()) | (B::atom())) -> integer() diff --git a/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl b/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl new file mode 100644 index 0000000000..b4409bc550 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl @@ -0,0 +1,12 @@ +-module(fun_app_args). + +-export([t/1]). + +-type ft() :: fun((a, []) -> any()). + +-record(r, { + h = c :: c | ft() +}). + +t(#r{h = H}) -> + fun(_) -> (H)(b, []) end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl b/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl deleted file mode 100644 index b36742b1bd..0000000000 --- a/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl +++ /dev/null @@ -1,7 +0,0 @@ --module(spec_other_module). - -%% OTP-15562 and ERL-845. Example provided by Kostis. - --type deep_list(A) :: [A | deep_list(A)]. - --spec lists:flatten(deep_list(A)) -> [A]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/union_paren.erl b/lib/dialyzer/test/small_SUITE_data/src/union_paren.erl new file mode 100644 index 0000000000..4691a57d98 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/union_paren.erl @@ -0,0 +1,24 @@ +-module(union_paren). + +-compile(export_all). + +t1() -> + t1(3.14). + +-spec t1((A :: integer()) | (B :: atom())) -> integer(). +t1(A) -> + fy:bar(A). + +t2() -> + t2(3.14). + +-spec t2(integer() | atom()) -> integer(). +t2(A) -> + fy:bar(A). + +t3() -> + 3.14 = t3(foo). + +-spec t3(_) -> (I :: integer()) | (A :: atom()). +t3(A) when is_atom(A) -> A; +t3(I) when is_integer(I) -> I. diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options b/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options index 56b36f2ed4..f7076e34da 100644 --- a/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [specdiffs]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [specdiffs]}]}. diff --git a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options index f7197ac30f..1a9734deb2 100644 --- a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [underspecs]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [underspecs]}]}. diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options b/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options index 49ac917f61..7de9d6f962 100644 --- a/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [unmatched_returns]}]}. +{dialyzer_options, [{indent_opt, false}, {warnings, [unmatched_returns]}]}. diff --git a/lib/dialyzer/test/user_SUITE_data/dialyzer_options b/lib/dialyzer/test/user_SUITE_data/dialyzer_options index 513ed7752b..0a944966f0 100644 --- a/lib/dialyzer/test/user_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/user_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, []}. +{dialyzer_options, [{indent_opt, false}]}. {time_limit, 3}.
\ No newline at end of file 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_data.erl b/lib/edoc/src/edoc_data.erl index 7c077d3acd..a8373d6536 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -345,6 +345,8 @@ deprecated(Repl, Env) -> deprecated(Desc) -> [{deprecated, description(Desc)}]. +-dialyzer({no_match, replacement_function/2}). + replacement_function(M0, {M,F,A}) when is_list(A) -> %% refer to the largest listed arity - the most general version replacement_function(M0, {M,F,lists:last(lists:sort(A))}); 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/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index bf9358c4d1..975a25d7a8 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Eldap application.</p> +<section><title>Eldap 1.2.7</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Back port of bug fix ERL-893 from OTP-22 and document + enhancements that will solve dialyzer warnings for users + of the ssl application.</p> + <p> + This change also affects public_key, eldap (and inet + doc).</p> + <p> + Own Id: OTP-15785 Aux Id: ERL-929, ERL-893, PR-2215 </p> + </item> + </list> + </section> + +</section> + <section><title>Eldap 1.2.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 6497922852..9b7e254dfe 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -957,20 +957,20 @@ do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup, Controls) -> do_unbind(Data) -> Req = "", log2(Data, "unbind request = ~p (has no reply)~n", [Req]), - case Data#eldap.using_tls of - true -> - send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), - ssl:close(Data#eldap.fd); - false -> - OldTrapExit = process_flag(trap_exit, true), - catch send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), - catch gen_tcp:close(Data#eldap.fd), - receive - {'EXIT', _From, _Reason} -> ok - after 0 -> ok - end, - process_flag(trap_exit, OldTrapExit) - end, + _ = case Data#eldap.using_tls of + true -> + send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), + ssl:close(Data#eldap.fd); + false -> + OldTrapExit = process_flag(trap_exit, true), + catch send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), + catch gen_tcp:close(Data#eldap.fd), + receive + {'EXIT', _From, _Reason} -> ok + after 0 -> ok + end, + process_flag(trap_exit, OldTrapExit) + end, {no_reply, Data#eldap{binddn = (#eldap{})#eldap.binddn, passwd = (#eldap{})#eldap.passwd, fd = (#eldap{})#eldap.fd, @@ -1130,7 +1130,7 @@ ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> %% Check if the SSL socket seems to be alive or not case catch ssl:sockname(Data#eldap.fd) of {error, _} -> - ssl:close(Data#eldap.fd), + _ = ssl:close(Data#eldap.fd), {error, ldap_closed}; {ok, _} -> {error, Emsg}; diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 6d541e4689..7f03fbd1b2 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.2.6 +ELDAP_VSN = 1.2.7 diff --git a/lib/erl_docgen/priv/dtd/book.dtd b/lib/erl_docgen/priv/dtd/book.dtd index aa07d38658..326bf3369a 100644 --- a/lib/erl_docgen/priv/dtd/book.dtd +++ b/lib/erl_docgen/priv/dtd/book.dtd @@ -30,7 +30,7 @@ insidecover?, pagetext, preamble, - (applications|parts|headline|pagetext)+, + (applications|parts|internals|headline|pagetext)+, (listoffigures?, listoftables?, listofterms?, @@ -56,6 +56,7 @@ <!ELEMENT applications (include)* > <!ELEMENT parts (title?,description?,(include|onepart)*) > <!ATTLIST parts lift (yes|no) "no" > +<!ELEMENT internals (include)* > <!ELEMENT headline (#PCDATA) > <!ELEMENT index EMPTY > <!ELEMENT listoffigures EMPTY > diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index b1578ad9d4..0ccd52068b 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -25,7 +25,7 @@ <!ENTITY % block "p|pre|code|list|taglist|codeinclude| erleval" > <!ENTITY % inline "#PCDATA|c|i|em|strong|term|cite|br|path|seealso| - url|marker|anno" > + url|marker|anno|image" > <!-- XXX --> <!ELEMENT p (%inline;)* > <!ELEMENT pre (#PCDATA|seealso|url|input|anno)* > diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index c9be926e1e..18bc8cd1cf 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -836,6 +836,10 @@ <!-- .../part --> <xsl:call-template name="part.content" /> </xsl:if> + <xsl:if test="$lname = 'internal'"> + <!-- .../internals --> + <xsl:call-template name="internal.content" /> + </xsl:if> <xsl:if test="$lname = 'chapter'"> <!-- .../part/chapter --> <xsl:call-template name="chapter.content"> @@ -859,12 +863,24 @@ <xsl:param name="chapnum"/> <xsl:param name="curModule"/> <xsl:if test="(local-name() = 'part') or ((local-name() = 'chapter') and ancestor::part)"> - <!-- .../part or.../part/chapter --> + <!-- .../part or .../part/chapter --> <xsl:call-template name="menu.ug"> <xsl:with-param name="chapnum" select="$chapnum"/> </xsl:call-template> </xsl:if> - <xsl:if test="(local-name() = 'application') or (local-name() = 'erlref')or (local-name() = 'comref')or (local-name() = 'cref')or (local-name() = 'fileref')or (local-name() = 'appref')"> + <xsl:if test="(local-name() = 'internal' and descendant::chapter) or ((local-name() = 'chapter') and ancestor::internal)"> + <!-- .../internal or .../internal/chapter --> + <xsl:call-template name="menu.internal.ug"> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:call-template> + </xsl:if> + <xsl:if test="(local-name() = 'internal' and descendant::erlref) or (((local-name() = 'erlref') or (local-name() = 'comref') or (local-name() = 'cref') or (local-name() = 'fileref') or (local-name() = 'appref')) and ancestor::internal)"> + <!-- .../internal,.../internal/erlref, .../internal/comref or .../internal/cref or .../internal/fileref or .../internal/appref --> + <xsl:call-template name="menu.internal.ref"> + <xsl:with-param name="curModule" select="$curModule"/> + </xsl:call-template> + </xsl:if> + <xsl:if test="(local-name() = 'application') or (((local-name() = 'erlref') or (local-name() = 'comref') or (local-name() = 'cref') or (local-name() = 'fileref') or (local-name() = 'appref')) and ancestor::application)"> <!-- .../application,.../application/erlref, .../application/comref or .../application/cref or .../application/fileref or .../application/appref --> <xsl:call-template name="menu.ref"> <xsl:with-param name="curModule" select="$curModule"/> @@ -902,6 +918,9 @@ <xsl:if test="boolean(/book/applications)"> <li><a href="index.html">Reference Manual</a></li> </xsl:if> + <xsl:if test="boolean(/book/internals)"> + <li><a href="internal_docs.html">Internal Documentation</a></li> + </xsl:if> <xsl:if test="boolean(/book/releasenotes)"> <li><a href="release_notes.html">Release Notes</a></li> </xsl:if> @@ -942,6 +961,7 @@ <xsl:template match="/book"> <xsl:apply-templates select="parts"/> <xsl:apply-templates select="applications"/> + <xsl:apply-templates select="internals"/> <xsl:apply-templates select="releasenotes"/> </xsl:template> @@ -955,6 +975,11 @@ <xsl:apply-templates select="application"/> </xsl:template> + <!-- Internals --> + <xsl:template match="internals"> + <xsl:apply-templates select="internal"/> + </xsl:template> + <!-- Header --> <xsl:template match="header"/> @@ -1311,6 +1336,90 @@ </xsl:template> + <!-- Internal Docs --> + + <!-- Part --> + <xsl:template match="internal"> + + <xsl:document href="{$outdir}/internal_docs.html" method="html" encoding="UTF-8" indent="yes" doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"> + <xsl:call-template name="pagelayout"/> + </xsl:document> + </xsl:template> + + + <!-- Part content--> + <xsl:template name="internal.content"> + <div class="frontpage"/> + + <center><h1><xsl:value-of select="/book/header/title"/> Internal Docs</h1></center> + + <center><h4>Version <xsl:value-of select="$appver"/></h4></center> + <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> + + <xsl:apply-templates select="chapter|erlref"/> + + </xsl:template> + + <!-- Menu.internal.chapter --> + <xsl:template name="menu.internal.ug"> + <xsl:param name="chapnum"/> + + <div id="leftnav"> + <div class="innertube"> + + <xsl:call-template name="erlang_logo"/> + + <p class="section-title"><xsl:value-of select="/book/header/title"/></p> + <p class="section-subtitle">Internal Documentation</p> + <p class="section-version">Version <xsl:value-of select="$appver"/></p> + + <xsl:call-template name="menu_top"/> + + <xsl:call-template name="menu_middle"/> + + <h3>Chapters</h3> + + <ul class="flipMenu" imagepath="{$topdocdir}/js/flipmenu"> + <xsl:call-template name="menu.chapter"> + <xsl:with-param name="entries" select="/book/internals/internal/chapter[header/title]"/> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:call-template> + </ul> + </div> + </div> + </xsl:template> + + <!-- Menu.internal.ref --> + <xsl:template name="menu.internal.ref"> + <xsl:param name="curModule"/> + <div id="leftnav"> + <div class="innertube"> + + <xsl:call-template name="erlang_logo"/> + + <p class="section-title"><xsl:value-of select="/book/header/title"/></p> + <p class="section-subtitle">Reference Manual</p> + <p class="section-version">Version <xsl:value-of select="$appver"/></p> + + <xsl:call-template name="menu_top"/> + + <xsl:call-template name="menu_middle"/> + + <h3>Table of Contents</h3> + + <ul class="flipMenu"> + <xsl:call-template name="menu.ref2"> + <xsl:with-param name="entries" select="/book/internals/internal/erlref[module]|/book/internals/internal/cref[lib]|/book/internals/internal/comref[com]|/book/internals/internal/fileref[file]|/book/internals/internal/appref[app]"/> + <!--xsl:with-param name="genFuncMenu" select="true"/--> + <xsl:with-param name="curModule" select="$curModule"/> + </xsl:call-template> + </ul> + </div> + </div> + </xsl:template> <!--Users Guide --> diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index d562cfddcc..5342d02947 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -1260,11 +1260,14 @@ get_text(#xmlElement{content=[E]}) -> %% text_and_name_only(Es) -> {N, Ts} text_and_a_name_only(Es) -> - [Name|_] = [Name || - #xmlElement{ - name = a, - attributes = [#xmlAttribute{name=name}]}=Name <- Es], - {Name#xmlElement{content = []}, text_only(Es)}. + case [Name || #xmlElement{ + name = a, + attributes = [#xmlAttribute{name=name}]}=Name <- Es] of + [Name|_] -> + {Name#xmlElement{content = []}, text_only(Es)}; + [] -> + {"", text_only(Es)} + end. %% text_only(Es) -> Ts %% Takes a list of xmlElement and xmlText and return a lists of xmlText. diff --git a/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl b/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl index 59d4dccfb7..9d69143c3c 100644 --- a/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl @@ -87,6 +87,7 @@ convert_tag(underline, Attrs) -> {em, Attrs}; convert_tag(Tag, Attrs) -> {Tag, Attrs}. is_url("http:"++_) -> true; +is_url("https:"++_) -> true; is_url("../"++_) -> true; is_url(FileRef) -> case filename:extension(FileRef) of diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index f081ca926a..c22f3fb0ce 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -183,6 +183,43 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret><nametext>ei_decode_bitstring(const char *buf, int *index, const char **pp, unsigned int *bitoffsp, size_t *nbitsp)</nametext></name> + <fsummary>Decode a bitstring.</fsummary> + <desc> + <p>Decodes a bit string from the binary format.</p> + <taglist> + <tag><c>pp</c></tag> + <item><p>Either <c>NULL</c> or <c>*pp</c> returns a pointer to + the first byte of the bit string. The returned bit string is + readable as long as the buffer pointed to by <c>buf</c> is + readable and not written to.</p> + </item> + <tag><c>bitoffsp</c></tag> + <item><p>Either <c>NULL</c> or <c>*bitoffsp</c> returns the + number of unused bits in the first byte pointed to by + <c>*pp</c>. The value of <c>*bitoffsp</c> is between 0 and 7. + Unused bits in the first byte are the most significant bits.</p> + </item> + <tag><c>nbitsp</c></tag> + <item><p>Either <c>NULL</c> or <c>*nbitsp</c> returns the length + of the bit string in <em>bits</em>.</p> + </item> + </taglist> + <p>Returns <c>0</c> if it was a bit string term.</p> + <p>The number of <em>bytes</em> pointed to by <c>*pp</c>, which are + part of the bit string, is <c>(*bitoffsp + *nbitsp + 7)/8</c>. If + <c>(*bitoffsp + *bitsp)%8 > 0</c> then only <c>(*bitoffsp + + *bitsp)%8</c> bits of the last byte are used. Unused bits in + the last byte are the least significant bits.</p> + <p>The values of unused bits in the first and last byte are undefined + and cannot be relied on.</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 +386,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 +498,28 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret> + <nametext>ei_encode_bitstring(char *buf, int *index, const char *p, size_t bitoffs, size_t nbits)</nametext></name> + <name since="OTP @OTP-15712@"><ret>int</ret> + <nametext>ei_x_encode_bitstring(ei_x_buff* x, const char *p, size_t bitoffs, size_t nbits)</nametext></name> + <fsummary>Encode a bitstring.</fsummary> + <desc> + <p>Encodes a bit string in the binary format.</p> + <p>The data is at <c>p</c>. The length of the bit string is <c>nbits</c> + bits. The first <c>bitoffs</c> bits of the data at <c>p</c> are unused. + The first byte which is part of the bit string is + <c>p[bitoffs/8]</c>. The <c>bitoffs%8</c> most significant bits of + the first byte <c>p[bitoffs/8]</c> are unused.</p> + <p>The number of bytes which is part of the bit string is <c>(bitoffs + + nbits + 7)/8</c>. If <c>(bitoffs + nbits)%8 > 0</c> then only <c>(bitoffs + + nbits)%8</c> bits of the last byte are used. Unused bits in + the last byte are the least significant bits.</p> + <p>The values of unused bits are disregarded and does not need to be + cleared.</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 +717,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 +790,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> @@ -784,30 +849,48 @@ ei_encode_tuple_header(buf, &i, 0);</pre> </type> <desc> <marker id="ei_set_compat_rel"></marker> - <p>By default, the <c>ei</c> library is only guaranteed - to be compatible with other Erlang/OTP components from the same - release as the <c>ei</c> library itself. For example, - <c>ei</c> from - Erlang/OTP R10 is not compatible with an Erlang emulator - from Erlang/OTP R9 by default.</p> - <p>A call to <c>ei_set_compat_rel(release_number)</c> sets - the <c>ei</c> library in compatibility mode of release - <c>release_number</c>. Valid range of - <c>release_number</c> - is <c>[7, current release]</c>. This makes it possible to - communicate with Erlang/OTP components from earlier releases.</p> + <p>In general, the <c>ei</c> library is guaranteed + to be compatible with other Erlang/OTP components that are 2 major + releases older or newer than the <c>ei</c> library itself.</p> + <p>Sometimes an exception to the above rule has to be made to make new + features (or even bug fixes) possible. A call to + <c>ei_set_compat_rel(release_number)</c> sets + the <c>ei</c> library in compatibility mode of OTP release + <c>release_number</c>.</p> + <p>The only useful value for <c>release_number</c> is currently + <c>21</c>. This will only be useful and have an effect if <em>bit + strings</em> or <em>export funs</em> are received from a connected + node. Before OTP 22, bit strings and export funs were not supported by + <c>ei</c>. They were instead encoded using an undocumented fallback + tuple format when sent from the emulator to <c>ei</c>:</p> + <taglist> + <tag><c>Bit string</c></tag> + <item><p>The term <c><<42, 1:1>></c> was encoded as + <c>{<<42, 128>>, 1}</c>. The first element of the tuple is a + binary and the second element denotes how many bits of the last bytes + are part of the bit string. In this example only the most significant + bit of the last byte (128) is part of the bit string.</p> + </item> + <tag><c>Export fun</c></tag> + <item><p>The term <c>fun lists:map/2</c> was encoded as + <c>{lists,map}</c>. A tuple with the module, function and a missing + arity.</p> + </item> + </taglist> + <p>If <c>ei_set_compat_rel(21)</c> is <em>not</em> called then a connected + emulator will send bit strings and export funs correctly encoded. The + functions <seealso marker="#ei_decode_bitstring"><c>ei_decode_bitstring</c></seealso> + and <seealso marker="#ei_decode_fun"><c>ei_decode_fun</c></seealso> + has to be used to decode such terms. Calling + <c>ei_set_compat_rel(21)</c> should only be done as a workaround to + keep an old implementation alive, which expects to receive the + undocumented tuple formats for bit strings and/or export funs. + </p> <note> <p>If this function is called, it can only be called once and must be called before any other functions in the <c>ei</c> library are called.</p> </note> - <warning> - <p>You can run into trouble if this feature is used - carelessly. Always ensure that all communicating - components are either from the same Erlang/OTP release, or - from release X and release Y where all components - from release Y are in compatibility mode of release X.</p> - </warning> </desc> </func> diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 32d28b853b..b331fd81b6 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,55 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <c>erl_interface</c>/<c>ei</c> refused to use node names + with an alive name (the part of the node name preceding + the @ sign) longer than 63 characters and a host name + longer than 64 characters. The total amount of characters + allowed in a node name (alivename@hostname) was thus + limited to 128 characters. These limits applied both to + the own node name as well as node names of other nodes. + Ordinary Erlang nodes limit the node name length to 256 + characters, which meant that you could not communicate + with certain Erlang nodes due to their node name used.</p> + <p> + <c>erl_interface</c>/<c>ei</c> now allow the total amount + of characters in a node name to be up to 256 characters. + These characters may be distributed between alive name + and host name in whatever way needed. That is, the + maximum amount of characters in the alive name may be 254 + and the maximum amount of characters in the host name may + be 254, but in total the node name must not exceed 256 + characters.</p> + <p> + Own Id: OTP-15781 Aux Id: ERIERL-356 </p> + </item> + </list> + </section> + +</section> + +<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 +202,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 +1668,3 @@ </section> </section> </chapter> - diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index aa2a49098f..b138118f04 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' @@ -210,12 +213,12 @@ extern volatile int __erl_errno; * library and when using the library we set a value that we use */ -#define EI_MAXHOSTNAMELEN 64 -#define EI_MAXALIVELEN 63 #define EI_MAX_COOKIE_SIZE 512 #define MAXATOMLEN (255 + 1) #define MAXATOMLEN_UTF8 (255*4 + 1) -#define MAXNODELEN EI_MAXALIVELEN+1+EI_MAXHOSTNAMELEN +#define EI_MAXHOSTNAMELEN (MAXATOMLEN - 2) +#define EI_MAXALIVELEN (MAXATOMLEN - 2) +#define MAXNODELEN MAXATOMLEN typedef enum { ERLANG_ASCII = 1, @@ -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; + } exprt; + } 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 char *p, size_t bitoffs, 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 char* p, size_t bitoffs, 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,15 @@ 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, const char** pp, + unsigned int* bitoffsp, size_t *nbitsp); + 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/Makefile.in b/lib/erl_interface/src/Makefile.in index b2600f0fab..6e0d3476c7 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -784,29 +784,31 @@ $(MDD_OBJDIR)/ei_fake_prog_mdd_cxx$(EXE): prog/ei_fake_prog.c $(MDD_EILIB) # Create dependency file using gcc -MM ########################################################################### -depend: +depend: $(TARGET)/depend.mk + +$(TARGET)/depend.mk: $(TARGET)/config.h $(gen_verbose) - $(V_colon)@echo "Generating dependency file depend.mk..." - @echo "# Generated dependency rules" > depend.mk; \ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ + $(V_colon)echo "Generating dependency file depend.mk..." + @echo "# Generated dependency rules" > $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk + sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' >> $@ + @echo >> $@ # For some reason this has to be after 'opt' target -include depend.mk +-include $(TARGET)/depend.mk # ---------------------------------------------------- # Release Target diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 7a304e6d4f..1b1479d2e9 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -791,14 +791,17 @@ int ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, if (strcmp(hp->h_name, "localhost") == 0) { /* We use a short node name */ if ((ct = strchr(thishostname, '.')) != NULL) *ct = '\0'; - sprintf(thisnodename, "%s@%s", this_node_name, thishostname); } else { /* We use a short node name */ if ((ct = strchr(hp->h_name, '.')) != NULL) *ct = '\0'; strcpy(thishostname, hp->h_name); - sprintf(thisnodename, "%s@%s", this_node_name, hp->h_name); } } + if (strlen(this_node_name) + 1 + strlen(thishostname) > MAXNODELEN) { + EI_TRACE_ERR0("ei_connect_init_ussi","this node name is too long"); + return ERL_ERROR; + } + sprintf(thisnodename, "%s@%s", this_node_name, thishostname); res = ei_connect_xinit_ussi(ec, thishostname, thisalivename, thisnodename, (struct in_addr *)*hp->h_addr_list, cookie, creation, cbs, cbs_sz, setup_context); @@ -889,6 +892,11 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) int ei_h_errno; #endif /* !win32 */ int res; + + if (strlen(nodename) > MAXNODELEN) { + EI_TRACE_ERR0("ei_connect","Too long nodename"); + return ERL_ERROR; + } /* extract the host and alive parts from nodename */ if (!(hostname = strchr(nodename,'@'))) { @@ -1846,6 +1854,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 +1876,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 +1885,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 +1957,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 +2251,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..0d28c67230 100644 --- a/lib/erl_interface/src/decode/decode_binary.c +++ b/lib/erl_interface/src/decode/decode_binary.c @@ -40,4 +40,41 @@ int ei_decode_binary(const char *buf, int *index, void *p, long *lenp) return 0; } +int ei_decode_bitstring(const char *buf, int *index, + const char** pp, + unsigned int* bitoffsp, + size_t *nbitsp) +{ + const char *s = buf + *index; + const char *s0 = s; + unsigned char last_bits; + const unsigned char tag = get8(s); + size_t len = get32be(s); + + switch(tag) { + case ERL_BINARY_EXT: + if (nbitsp) + *nbitsp = len * 8; + break; + case ERL_BIT_BINARY_EXT: + last_bits = get8(s); + if (((last_bits==0) != (len==0)) || last_bits > 8) + return -1; + + if (nbitsp) + *nbitsp = (len == 0) ? 0 : ((len-1) * 8) + last_bits; + break; + default: + return -1; + } + + if (pp) + *pp = s; + if (bitoffsp) + *bitoffsp = 0; + + s += len; + *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..3a7a2b01c1 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.exprt.func = p_func; + p->u.exprt.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.exprt.func = p_func; + p->u.exprt.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.exprt.func_allocated) + ei_free(f->u.exprt.func); + break; + } } diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c index 0db315f09b..736c00e074 100644 --- a/lib/erl_interface/src/decode/decode_skip.c +++ b/lib/erl_interface/src/decode/decode_skip.c @@ -27,7 +27,7 @@ int ei_skip_term(const char* buf, int* index) /* 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 +54,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 +79,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, NULL, 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/depend.mk b/lib/erl_interface/src/depend.mk deleted file mode 100644 index af753046e5..0000000000 --- a/lib/erl_interface/src/depend.mk +++ /dev/null @@ -1,1133 +0,0 @@ -# Generated dependency rules -$(ST_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(ST_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(ST_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(ST_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(ST_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(ST_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(ST_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(ST_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(ST_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(ST_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(ST_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(ST_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(ST_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(ST_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(ST_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(ST_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(ST_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(ST_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(ST_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(ST_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(ST_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(ST_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(ST_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(ST_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(ST_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(ST_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(ST_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(ST_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(ST_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(ST_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(ST_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(ST_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(ST_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(ST_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(ST_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(ST_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(ST_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(ST_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(ST_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(ST_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(ST_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(ST_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(ST_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(ST_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(ST_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(ST_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MT_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MT_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MT_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MT_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MT_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MT_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MT_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MT_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MT_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MT_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MT_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MT_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MT_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MT_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MT_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MT_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MT_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MT_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MT_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MT_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MT_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MT_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MT_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MT_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MT_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MT_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MT_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MT_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MT_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MT_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MT_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MT_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MT_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MT_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MT_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MT_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MT_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MT_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MT_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MT_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MT_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MT_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MT_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MT_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MT_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MT_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MD_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MD_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MD_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MD_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MD_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MD_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MD_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MD_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MD_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MD_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MD_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MD_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MD_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MD_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MD_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MD_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MD_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MD_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MD_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MD_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MD_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MD_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MD_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MD_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MD_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MD_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MD_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MD_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MD_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MD_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MD_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MD_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MD_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MD_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MD_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MD_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MD_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MD_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MD_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MD_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MD_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MD_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MD_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MD_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MD_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MD_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MDD_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MDD_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MDD_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MDD_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MDD_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MDD_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MDD_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MDD_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MDD_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MDD_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MDD_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MDD_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MDD_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MDD_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MDD_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MDD_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MDD_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MDD_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MDD_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MDD_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MDD_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MDD_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MDD_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MDD_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MDD_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MDD_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MDD_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MDD_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MDD_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MDD_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MDD_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MDD_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MDD_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MDD_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MDD_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MDD_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MDD_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MDD_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MDD_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MDD_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MDD_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MDD_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MDD_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MDD_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MDD_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MDD_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - diff --git a/lib/erl_interface/src/encode/encode_binary.c b/lib/erl_interface/src/encode/encode_binary.c index 4471c51769..0562979417 100644 --- a/lib/erl_interface/src/encode/encode_binary.c +++ b/lib/erl_interface/src/encode/encode_binary.c @@ -22,6 +22,10 @@ #include "eiext.h" #include "putget.h" +static void copy_bits(const unsigned char* src, size_t soffs, + unsigned char* dst, size_t n); + + int ei_encode_binary(char *buf, int *index, const void *p, long len) { char *s = buf + *index; @@ -40,3 +44,106 @@ int ei_encode_binary(char *buf, int *index, const void *p, long len) return 0; } +int ei_encode_bitstring(char *buf, int *index, + const char *p, + size_t bitoffs, + size_t bits) +{ + char *s = buf + *index; + char *s0 = s; + size_t bytes = (bits + 7) / 8; + char last_bits = bits % 8; + + if (!buf) s += last_bits ? 6 : 5; + else { + char* tagp = s++; + put32be(s, bytes); + if (last_bits) { + *tagp = ERL_BIT_BINARY_EXT; + put8(s, last_bits); + } + else + *tagp = ERL_BINARY_EXT; + + copy_bits((const unsigned char*)p, bitoffs, (unsigned char*)s, bits); + } + s += bytes; + + *index += s-s0; + + return 0; +} + + +/* + * MAKE_MASK(n) constructs a mask with n bits. + * Example: MAKE_MASK(3) returns the binary number 00000111. + */ +#define MAKE_MASK(n) ((((unsigned) 1) << (n))-1) + + +static +void copy_bits(const unsigned char* src, /* Base pointer to source. */ + size_t soffs, /* Bit offset for source relative to src. */ + unsigned char* dst, /* Destination. */ + size_t n) /* Number of bits to copy. */ +{ + unsigned rmask; + unsigned count; + unsigned deoffs; + unsigned bits; + unsigned bits1; + unsigned rshift; + + if (n == 0) + return; + + deoffs = n & 7; + rmask = deoffs ? (MAKE_MASK(deoffs) << (8-deoffs)) : 0; + + if (soffs == 0) { + unsigned nbytes = (n + 7) / 8; + memcpy(dst, src, nbytes); + if (rmask) + dst[nbytes-1] &= rmask; + return; + } + + src += soffs / 8; + soffs &= 7; + + if (n < 8) { /* Less than one byte */ + bits = (*src << soffs); + if (soffs+n > 8) { + src++; + bits |= (*src >> (8 - soffs)); + } + *dst = bits & rmask; + return; + } + + count = n >> 3; + + rshift = 8 - soffs; + bits = *src; + if (soffs + n > 8) { + src++; + } + + while (count--) { + bits1 = bits << soffs; + bits = *src; + src++; + *dst = bits1 | (bits >> rshift); + dst++; + } + + if (rmask) { + bits1 = bits << soffs; + if ((rmask << rshift) & 0xff) { + bits = *src; + bits1 |= (bits >> rshift); + } + *dst = bits1 & rmask; + } +} diff --git a/lib/erl_interface/src/encode/encode_fun.c b/lib/erl_interface/src/encode/encode_fun.c index 3bfc7530d1..e29424f9f4 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.exprt.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/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c index 0dfdb16372..d14746b40f 100644 --- a/lib/erl_interface/src/encode/encode_pid.c +++ b/lib/erl_interface/src/encode/encode_pid.c @@ -25,6 +25,7 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) { char* s = buf + *index; + const char tag = (p->creation > 3) ? ERL_NEW_PID_EXT : ERL_PID_EXT; ++(*index); /* skip ERL_PID_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), @@ -32,17 +33,21 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) return -1; if (buf) { - put8(s, ERL_NEW_PID_EXT); + put8(s, tag); s = buf + *index; /* now the integers */ put32be(s,p->num & 0x7fff); /* 15 bits */ put32be(s,p->serial & 0x1fff); /* 13 bits */ - put32be(s, p->creation); /* 32 bits */ + if (tag == ERL_PID_EXT) { + put8(s,(p->creation & 0x03)); /* 2 bits */ + } else { + put32be(s, p->creation); /* 32 bits */ + } } - *index += 4 + 4 + 4; + *index += 4 + 4 + (tag == ERL_PID_EXT ? 1 : 4); return 0; } diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c index 0fb4018db1..eb464380c0 100644 --- a/lib/erl_interface/src/encode/encode_port.c +++ b/lib/erl_interface/src/encode/encode_port.c @@ -25,6 +25,7 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) { char *s = buf + *index; + const char tag = p->creation > 3 ? ERL_NEW_PORT_EXT : ERL_PORT_EXT; ++(*index); /* skip ERL_PORT_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, @@ -32,15 +33,19 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) return -1; } if (buf) { - put8(s, ERL_NEW_PORT_EXT); + put8(s, tag); s = buf + *index; /* now the integers */ put32be(s,p->id & 0x0fffffff /* 28 bits */); - put32be(s, p->creation); + if (tag == ERL_PORT_EXT) { + put8(s,(p->creation & 0x03)); + } else { + put32be(s, p->creation); + } } - *index += 4 + 4; + *index += 4 + (tag == ERL_PORT_EXT ? 1 : 4); return 0; } diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c index 8c2e0a25f7..5ccfc32c6d 100644 --- a/lib/erl_interface/src/encode/encode_ref.c +++ b/lib/erl_interface/src/encode/encode_ref.c @@ -24,6 +24,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) { + const char tag = (p->creation > 3) ? ERL_NEWER_REFERENCE_EXT : ERL_NEW_REFERENCE_EXT; char *s = buf + *index; int i; @@ -36,7 +37,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) /* Always encode as an extended reference; all participating parties are now expected to be able to decode extended references. */ if (buf) { - put8(s, ERL_NEWER_REFERENCE_EXT); + put8(s, tag); /* first, number of integers */ put16be(s, p->len); @@ -45,12 +46,15 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) s = buf + *index; /* now the integers */ - put32be(s, p->creation); + if (tag == ERL_NEW_REFERENCE_EXT) + put8(s,(p->creation & 0x03)); + else + put32be(s, p->creation); for (i = 0; i < p->len; i++) put32be(s,p->n[i]); } - *index += p->len*4 + 4; + *index += p->len*4 + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4); 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..5c40fb7747 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: { + const char* cp; + size_t bits; + unsigned int bitoffs; + int trunc = 0; + + if (ei_decode_bitstring(buf, index, &cp, &bitoffs, &bits) < 0 + || bitoffs != 0) { + 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,", cp[i]); + } + ch_written += xprintf(fp, x, "%d", cp[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; + 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..8e77679d2a 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 char* p, size_t bitoffs, size_t bits) +{ + int i = x->index; + if (ei_encode_bitstring(NULL, &i, p, bitoffs, bits) == -1) + return -1; + if (!x_fix_buff(x, i)) + return -1; + return ei_encode_bitstring(x->buff, &x->index, p, bitoffs, 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..805d69e9b3 100644 --- a/lib/erl_interface/src/misc/show_msg.c +++ b/lib/erl_interface/src/misc/show_msg.c @@ -342,7 +342,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 +455,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, NULL, &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..385bcdd422 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,9 @@ static void cmd_ei_send_funs(char* buf, int len) erlang_pid pid; ei_x_buff x; erlang_fun fun1, fun2; + char* bitstring; + size_t bits; + int bitoffs; if (ei_decode_long(buf, &index, &fd) < 0) fail("expected long"); @@ -219,20 +219,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, &bitoffs, &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, bitoffs, 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..46d6b8f2af 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,134 @@ 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) +{ + const char* p; + char *buf; + size_t bits; + int bitoffs; + 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, &bitoffs, &bits); + message("err = %d, size = %d, bitoffs = %d, bits = %d, expected size = %d, expected bits = %d\n",\ + err,size1, bitoffs, (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; + } + if (bitoffs != 0) { + fail("non zero bit offset"); + return; + } + + err = ei_decode_bitstring(buf+1, &size2, &p, NULL, &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 +712,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..3451d9f503 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -120,9 +120,31 @@ 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)], + + % And last an ugly duckling to test ei_encode_bitstring with bitoffs != 0 + encode_bitstring(P), + runner:recv_eot(P), ok. +encode_bitstring(P) -> + %% Send one bitstring to c-node + Bits = <<16#18f6d4b2907e5c3a1:66>>, + P ! {self(), {command, term_to_binary(Bits, [{minor_version, 2}])}}, + + %% and then receive and verify a number of different sub-bitstrings + receive_sub_bitstring(P, Bits, 0, bit_size(Bits)). + +receive_sub_bitstring(_, _, _, NBits) when NBits < 0 -> + ok; +receive_sub_bitstring(P, Bits, BitOffs, NBits) -> + <<_:BitOffs, Sub:NBits/bits, _/bits>> = Bits, + %%io:format("expecting term_to_binary(~p) = ~p\n", [Sub, term_to_binary(Sub)]), + {_B,Sub} = get_buf_and_term(P), + receive_sub_bitstring(P, Bits, BitOffs+1, NBits - ((NBits div 20)+1)). + + %% ######################################################################## %% 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..85ca6c56e9 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,13 @@ typedef struct erlang_char_encoding enc; }my_atom; +typedef struct +{ + const char* bytes; + unsigned int bitoffs; + size_t nbits; +}my_bitstring; + struct my_obj { union { erlang_fun fun; @@ -49,6 +56,7 @@ struct my_obj { erlang_trace trace; erlang_big big; my_atom atom; + my_bitstring bits; int arity; }u; @@ -119,6 +127,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), + (a ? &a->bitoffs : NULL), + (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->bitoffs, a->nbits); +} +int ei_x_encode_my_bits(ei_x_buff* x, my_bitstring* a) +{ + return ei_x_encode_bitstring(x, a->bytes, a->bitoffs, 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) { @@ -237,11 +265,7 @@ void decode_encode(struct Type** tv, int nobj) size1 = 0; err = t->ei_decode_fp(inp, &size1, NULL); if (err != 0) { - if (err != -1) { - fail("decode returned non zero but not -1"); - } else { - fail1("decode '%s' returned non zero", t->name); - } + fail2("decode '%s' returned non zero %d", t->name, err); return; } if (size1 < 1) { @@ -470,6 +494,66 @@ void decode_encode_big(struct Type* t) } +void encode_bitstring(void) +{ + char* packet; + char* inp; + char out_buf[BUFSZ]; + int size; + int err, i; + ei_x_buff arg; + const char* p; + unsigned int bitoffs; + size_t nbits, org_nbits; + + packet = read_packet(NULL); + inp = packet+1; + + size = 0; + err = ei_decode_bitstring(inp, &size, &p, &bitoffs, &nbits); + if (err != 0) { + fail1("ei_decode_bitstring returned non zero %d", err); + return; + } + + /* + * Now send a bunch of different sub-bitstrings back + * encoded both with ei_encode_ and ei_x_encode_. + */ + org_nbits = nbits; + do { + size = 0; + err = ei_encode_bitstring(out_buf, &size, p, bitoffs, nbits); + if (err != 0) { + fail1("ei_encode_bitstring returned non zero %d", err); + return; + } + + ei_x_new(&arg); + err = ei_x_encode_bitstring(&arg, p, bitoffs, nbits); + if (err != 0) { + fail1("ei_x_encode_bitstring returned non zero %d", err); + ei_x_free(&arg); + return; + } + + if (arg.index < 1) { + fail("size is < 1"); + ei_x_free(&arg); + return; + } + + send_buffer(out_buf, size); + send_buffer(arg.buff, arg.index); + ei_x_free(&arg); + + bitoffs++; + nbits -= (nbits / 20) + 1; + } while (nbits < org_nbits); + + free_packet(packet); +} + /* ******************************************************************** */ @@ -537,6 +621,12 @@ TESTCASE(test_ei_decode_encode) decode_encode(map, 7); } + for (i=0; i <= 48; i++) { + decode_encode_one(&my_bitstring_type); + } + + encode_bitstring(); + report(1); } diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 4605293c74..77910a9fc7 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -73,10 +73,6 @@ -import(runner, [get_term/1]). --define(REFERENCE_EXT, $e). --define(NEW_REFERENCE_EXT, $r). --define(NEWER_REFERENCE_EXT, $Z). - %% This test suite controls the running of the C language functions %% in eterm_test.c and print_term.c. @@ -1030,11 +1026,9 @@ cnode_1(Config) when is_list(Config) -> check_ref(Ref) -> case bin_ext_type(Ref) of - ?REFERENCE_EXT -> + 101 -> ct:fail(oldref); - ?NEW_REFERENCE_EXT -> - ok; - ?NEWER_REFERENCE_EXT -> + 114 -> ok; Type -> ct:fail({type, Type}) diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index dae6052d55..4e31b3835d 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.3 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d61cd8664c..badf58936f 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -5338,7 +5338,15 @@ t_form_to_string({type, _L, tuple, any}) -> "tuple()"; t_form_to_string({type, _L, tuple, Args}) -> "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}"; t_form_to_string({type, _L, union, Args}) -> - flat_join(t_form_to_string_list(Args), " | "); + flat_join(lists:map(fun(Arg) -> + case Arg of + {ann_type, _AL, _} -> + "(" ++ t_form_to_string(Arg) ++ ")"; + _ -> + t_form_to_string(Arg) + end + end, Args), + " | "); t_form_to_string({type, _L, Name, []} = T) -> try M = mod, diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index 480290cd9e..61d92fdffe 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -64,9 +64,7 @@ <taglist> <tag>Binary matching</tag> <item><p>The HiPE compiler will crash on modules containing binary - matching unless they have been compiled with the <c>+no_bsm3</c> flag. - Note that this will disable all related optimizations done by the BEAM - compiler.</p> + matching.</p> </item> <tag>Stack traces</tag> 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/src/http_server/mod_responsecontrol.erl b/lib/inets/src/http_server/mod_responsecontrol.erl index 07129940a5..a32ba65c22 100644 --- a/lib/inets/src/http_server/mod_responsecontrol.erl +++ b/lib/inets/src/http_server/mod_responsecontrol.erl @@ -71,7 +71,7 @@ do_responsecontrol(Info) -> %% If a client sends more then one of the if-XXXX fields in a request -%% The standard says it does not specify the behaviuor so I specified it :-) +%% The standard says it does not specify the behaviour so I specified it :-) %% The priority between the fields is %% 1.If-modified %% 2.If-Unmodified 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/doc/src/jinterface_users_guide.xml b/lib/jinterface/doc/src/jinterface_users_guide.xml index 56f88124bf..504c77f339 100644 --- a/lib/jinterface/doc/src/jinterface_users_guide.xml +++ b/lib/jinterface/doc/src/jinterface_users_guide.xml @@ -366,20 +366,20 @@ OtpNode node = new OtpNode("gurka"); </code> <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd">OtpEpmd</seealso> class. Nodes wishing to contact other nodes must first request information from Epmd before a connection can be set up, however this is done automatically - by <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect(com.ericsson.otp.erlang.OtpPeer)">OtpSelf.connect()</seealso> when necessary. </p> - <p>When you use <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect(com.ericsson.otp.erlang.OtpPeer)">OtpSelf.connect()</seealso> to connect to an Erlang node, + by <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect-com.ericsson.otp.erlang.OtpPeer-">OtpSelf.connect()</seealso> when necessary. </p> + <p>When you use <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect-com.ericsson.otp.erlang.OtpPeer-">OtpSelf.connect()</seealso> to connect to an Erlang node, a connection is first made to epmd and, if the node is known, a connection is then made to the Erlang node.</p> <p>Java nodes can also register themselves with epmd if they want other nodes in the system to be able to find and connect to them. - This is done by call to method <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#publishPort(com.ericsson.otp.erlang.OtpLocalNode)">OtpEpmd.publishPort()</seealso>.</p> + This is done by call to method <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#publishPort-com.ericsson.otp.erlang.OtpLocalNode-">OtpEpmd.publishPort()</seealso>.</p> <p>Be aware that on some systems (such as VxWorks), a failed node will not be detected by this mechanism since the operating system does not automatically close descriptors that were left open when the node failed. If a node has failed in this way, epmd will prevent you from registering a new node with the old name, since it thinks that the old name is still in use. In this case, you must unregister the name - explicitly, by using <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#unPublishPort(com.ericsson.otp.erlang.OtpLocalNode)">OtpEpmd.unPublishPort()</seealso></p> + explicitly, by using <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#unPublishPort-com.ericsson.otp.erlang.OtpLocalNode-">OtpEpmd.unPublishPort()</seealso></p> <p>This will cause epmd to close the connection from the far end. Note that if the name was in fact still in use by a node, the results of this operation are unpredictable. Also, doing this does not cause the 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/doc/src/application.xml b/lib/kernel/doc/src/application.xml index 83a83ebad2..f4ec2c610f 100644 --- a/lib/kernel/doc/src/application.xml +++ b/lib/kernel/doc/src/application.xml @@ -582,7 +582,7 @@ Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code> the primary application) for the primary application and all included applications, for which the start phase is defined.</p> <p>For a description of <c>StartType</c>, see - <seealso marker="Module:start/2"><c>Module:start/2</c></seealso>.</p> + <seealso marker="#Module:start/2"><c>Module:start/2</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/kernel/doc/src/auth.xml b/lib/kernel/doc/src/auth.xml index a57da18de9..c735d02fed 100644 --- a/lib/kernel/doc/src/auth.xml +++ b/lib/kernel/doc/src/auth.xml @@ -46,7 +46,7 @@ <fsummary>Magic cookie for local node (deprecated).</fsummary> <desc> <p>Use - <seealso marker="erts:erlang#erlang:get_cookie/0"><c>erlang:get_cookie()</c></seealso> + <seealso marker="erts:erlang#get_cookie/0"><c>erlang:get_cookie()</c></seealso> in ERTS instead.</p> </desc> </func> @@ -58,7 +58,7 @@ </type_desc> <desc> <p>Use - <seealso marker="erts:erlang#erlang:set_cookie/2"><c>erlang:set_cookie(node(), <anno>Cookie</anno>)</c> + <seealso marker="erts:erlang#set_cookie/2"><c>erlang:set_cookie(node(), <anno>Cookie</anno>)</c> in ERTS</seealso> instead.</p> </desc> </func> @@ -94,7 +94,7 @@ <p>Sets the magic cookie of <c><anno>Node</anno></c> to <c><anno>Cookie</anno></c> and verifies the status of the authorization. Equivalent to calling - <seealso marker="erts:erlang#erlang:set_cookie/2"><c>erlang:set_cookie(<anno>Node</anno>, <anno>Cookie</anno>)</c></seealso>, followed by + <seealso marker="erts:erlang#set_cookie/2"><c>erlang:set_cookie(<anno>Node</anno>, <anno>Cookie</anno>)</c></seealso>, followed by <seealso marker="#is_auth/1"><c>auth:is_auth(<anno>Node</anno>)</c></seealso>.</p> </desc> </func> diff --git a/lib/kernel/doc/src/erl_ddll.xml b/lib/kernel/doc/src/erl_ddll.xml index f2d5e1b397..52d5bcd079 100644 --- a/lib/kernel/doc/src/erl_ddll.xml +++ b/lib/kernel/doc/src/erl_ddll.xml @@ -200,7 +200,7 @@ <fsummary>Remove a monitor for a driver.</fsummary> <desc> <p>Removes a driver monitor in much the same way as - <seealso marker="erts:erlang#erlang:demonitor/1"><c>erlang:demonitor/1</c></seealso> + <seealso marker="erts:erlang#demonitor/1"><c>erlang:demonitor/1</c></seealso> in ERTS does with process monitors. For details about how to create driver monitors, see @@ -430,7 +430,7 @@ <desc> <p>Creates a driver monitor and works in many ways as - <seealso marker="erts:erlang#erlang:monitor/2"><c>erlang:monitor/2</c></seealso> + <seealso marker="erts:erlang#monitor/2"><c>erlang:monitor/2</c></seealso> in ERTS, does for processes. When a driver changes state, the monitor results in a monitor message that is sent to the calling diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index f70d6c24db..61ac1485c1 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -253,7 +253,7 @@ connect(Socket, Ip, Port>, <desc> <p>Assigns a new controlling process <c><anno>Pid</anno></c> to <c><anno>Socket</anno></c>. Same implementation as - <seealso marker="gen_udp:controlling_process/2"><c>gen_udp:controlling_process/2</c></seealso>. + <seealso marker="gen_udp#controlling_process/2"><c>gen_udp:controlling_process/2</c></seealso>. </p> </desc> </func> diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index fc16473393..f8b41d24e2 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -259,6 +259,12 @@ do_recv(Sock, Bs) -> <p>The optional <c><anno>Timeout</anno></c> parameter specifies a time-out in milliseconds. Defaults to <c>infinity</c>.</p> <note> + <p>Keep in mind that if the underlying OS <c>connect()</c> call returns + a timeout, <c>gen_tcp:connect</c> will also return a timeout + (i.e. <c>{error, etimedout}</c>), even if a larger <c>Timeout</c> was + specified.</p> + </note> + <note> <p>The default values for options specified to <c>connect</c> can be affected by the Kernel configuration parameter <c>inet_default_connect_options</c>. For details, see diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 709ba8e8fd..d4678ca5db 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -294,6 +294,9 @@ fe80::204:acff:fe17:bf38 <datatype> <name name="socket_protocol"/> </datatype> + <datatype> + <name name="stat_option"/> + </datatype> </datatypes> <funcs> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 8458ffa042..1aa4b7a3a2 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -718,7 +718,7 @@ logger:debug(#{got => connection_request, id => Id, state => State}, </seealso></pre> <p>For all other values of <c>HandlerId</c>, this entry adds a new handler, equivalent to calling</p> - <pre><seealso marker="logger:add_handler/3"> + <pre><seealso marker="logger#add_handler/3"> logger:add_handler(HandlerId, Module, HandlerConfig) </seealso></pre> <p>Multiple entries of this type are allowed.</p></item> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 0c187eb19f..61bd598145 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 6.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a performance regression when reading files + opened with the <c>compressed</c> flag.</p> + <p> + Own Id: OTP-15706 Aux Id: ERIERL-336 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 0bec78e938..cdb2d2f1f6 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -21,6 +21,8 @@ -behaviour(supervisor). +-include_lib("kernel/include/logger.hrl"). + -export([start_link/0,start_link/2,init/1,start/1,stop/0]). -define(DBG,erlang:display([?MODULE,?LINE])). @@ -83,6 +85,10 @@ do_start_link([{Arg,Flag}|T]) -> case init:get_argument(Arg) of {ok,[[Name]]} -> start_link([list_to_atom(Name),Flag|ticktime()], true); + {ok,[[Name]|_Rest]} -> + ?LOG_WARNING("Multiple -~p given to erl, using the first, ~p", + [Arg, Name]), + start_link([list_to_atom(Name),Flag|ticktime()], true); _ -> do_start_link(T) end; diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index f31a1722ce..7a14e2635c 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -33,10 +33,10 @@ -define(erlang_daemon_port, 4369). -endif. -ifndef(epmd_dist_high). --define(epmd_dist_high, 6). +-define(epmd_dist_high, 4370). -endif. -ifndef(epmd_dist_low). --define(epmd_dist_low, 5). +-define(epmd_dist_low, 4370). -endif. %% External exports @@ -342,13 +342,6 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of - [$v, Result, A, B, C, D] -> - case Result of - 0 -> - {alive, Socket, ?u32(A, B, C, D)}; - _ -> - {error, duplicate_name} - end; [$y, Result, A, B] -> case Result of 0 -> 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/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 3f5a2ea5ee..630ef5d2f7 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1226,7 +1226,8 @@ handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From, _ -> ets:insert(Db, {TagInfo, undefined}), TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough - ets:insert(Db, {TagTm, TimeZero}) + ets:insert(Db, {TagTm, TimeZero}), + <<>> end, handle_set_file(ParseFun, Bin, From, State); false -> {reply,error,State} diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index 8fa3f5c588..aca3247c8f 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -43,7 +43,9 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -60,4 +62,6 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 111d103df2..bfa091a036 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -68,7 +68,7 @@ config_change(Changed, New, Removed) -> %%% auth, ...) ...) %%% %%% The rectangular boxes are supervisors. All supervisors except -%%% for kernel_safe_sup terminates the enitre erlang node if any of +%%% for kernel_safe_sup terminates the entire erlang node if any of %%% their children dies. Any child that can't be restarted in case %%% of failure must be placed under one of these supervisors. Any %%% other child must be placed under safe_sup. These children may diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index 08286dd476..69ff8e7971 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -120,7 +120,7 @@ server1(Iport, Oport, Shell) -> {Curr,Shell1} = case init:get_argument(remsh) of {ok,[[Node]]} -> - ANode = list_to_atom(Node), + ANode = list_to_atom(append_hostname(Node)), RShell = {ANode,shell,start,[]}, RGr = group:start(self(), RShell, rem_sh_opts(ANode)), {RGr,RShell}; @@ -139,6 +139,12 @@ server1(Iport, Oport, Shell) -> %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr, {false, queue:new()}). +append_hostname(Node) -> + case string:find(Node, "@") of + nomatch -> Node ++ string:find(atom_to_list(node()), "@"); + _ -> Node + end. + rem_sh_opts(Node) -> [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 8dd4ef1987..c3a022df0a 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -205,6 +205,9 @@ nodenames(Config) when is_list(Config) -> legal("a-1@b"), legal("a_1@b"), + %% Test that giving two -sname works as it should + test_node("a_1@b", false, long_or_short() ++ "a_0@b"), + illegal("cdé@a"), illegal("te欢st@a"). @@ -258,8 +261,11 @@ illegal(Name) -> test_node(Name) -> test_node(Name, false). test_node(Name, Illigal) -> + test_node(Name, Illigal, ""). +test_node(Name, Illigal, ExtraArgs) -> ProgName = ct:get_progname(), - Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++ + Command = ProgName ++ " -noinput " ++ ExtraArgs ++ + long_or_short() ++ Name ++ " -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++ case Illigal of true -> diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index f3db6705a2..8256444bdc 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -47,9 +47,6 @@ R end). --define(EPMD_DIST_HIGH, 6). --define(EPMD_DIST_LOW, 5). - -define(DFLAG_PUBLISHED,1). -define(DFLAG_ATOM_CACHE,2). -define(DFLAG_EXTENDED_REFERENCES,4). @@ -60,18 +57,15 @@ -define(DFLAG_NEW_FUN_TAGS,16#80). -define(DFLAG_EXTENDED_PIDS_PORTS,16#100). -define(DFLAG_UTF8_ATOMS, 16#10000). --define(DFLAG_BIG_CREATION, 16#40000). %% From R9 and forward extended references is compulsory %% From R10 and forward extended pids and ports are compulsory %% From R20 and forward UTF8 atoms are compulsory %% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...}) -%% From R22 and forward BIG_CREATION is compulsory -define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS bor ?DFLAG_UTF8_ATOMS bor - ?DFLAG_NEW_FUN_TAGS bor - ?DFLAG_BIG_CREATION)). + ?DFLAG_NEW_FUN_TAGS)). -define(PASS_THROUGH, $p). @@ -214,9 +208,9 @@ pending_up_md5(Node,OurName,Cookie) -> {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), ok = recv_status(SocketA), - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1) + {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), @@ -230,11 +224,11 @@ pending_up_md5(Node,OurName,Cookie) -> {ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketB,OurName, ?EPMD_DIST_HIGH), + send_name(SocketB,OurName,5), alive = recv_status(SocketB), send_status(SocketB, true), gen_tcp:close(SocketA), - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeB} = recv_challenge(SocketB), % See 1) + {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1) OurChallengeB = gen_challenge(), OurDigestB = gen_digest(HisChallengeB, Cookie), send_challenge_reply(SocketB, OurChallengeB, OurDigestB), @@ -260,7 +254,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> Else -> exit(Else) end, - EpmdSocket = register_node(OurName, LSocket, ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH), + EpmdSocket = register(OurName, LSocket, 1, 5), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, @@ -268,7 +262,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), %% We are still not marked up on the other side, as our first message %% is not sent. SocketB = case gen_tcp:accept(LSocket) of @@ -281,11 +275,11 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> %% Now we are expected to close A gen_tcp:close(SocketA), %% But still Socket B will continue - {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1) + {normal,Node,5} = recv_name(SocketB), % See 1) send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), - send_challenge(SocketB, OurName, MyChallengeB, ?EPMD_DIST_HIGH), - {ok,HisChallengeB} = recv_challenge_reply(SocketB, MyChallengeB, Cookie), + send_challenge(SocketB, OurName, MyChallengeB,5), + HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), DigestB = gen_digest(HisChallengeB,Cookie), send_challenge_ack(SocketB, DigestB), inet:setopts(SocketB, [{active, false}, @@ -307,8 +301,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else -> exit(Else) end, - EpmdSocket = register_node(OurName, LSocket, - ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH), + EpmdSocket = register(OurName, LSocket, 1, 5), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, @@ -322,16 +315,16 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else2 -> exit(Else2) end, - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), ok_simultaneous = recv_status(SocketA), %% Socket B should die during this case catch begin - {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1) + {normal,Node,5} = recv_name(SocketB), % See 1) send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), send_challenge(SocketB, OurName, MyChallengeB, 5), - {ok,HisChallengeB} = recv_challenge_reply( + HisChallengeB = recv_challenge_reply( SocketB, MyChallengeB, Cookie), @@ -353,7 +346,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> end, gen_tcp:close(SocketB), %% But still Socket A will continue - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1) + {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), @@ -379,7 +372,7 @@ missing_compulsory_dflags(Config) when is_list(Config) -> [{active,false}, {packet,2}]), BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)), - send_name(SocketA,BadNode, ?EPMD_DIST_HIGH, 0), + send_name(SocketA,BadNode,5,0), not_allowed = recv_status(SocketA), gen_tcp:close(SocketA), stop_node(Node), @@ -523,16 +516,16 @@ send_challenge_reply(Socket, Challenge, Digest) -> recv_challenge_reply(Socket, ChallengeA, Cookie) -> case gen_tcp:recv(Socket, 0) of - {ok,[$r,CB3,CB2,CB1,CB0 | SumB]=Data} when length(SumB) == 16 -> + {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 -> SumA = gen_digest(ChallengeA, Cookie), ChallengeB = ?u32(CB3,CB2,CB1,CB0), if SumB == SumA -> - {ok,ChallengeB}; + ChallengeB; true -> - {error,Data} + ?shutdown(bad_challenge_reply) end; - Err -> - {error,Err} + _ -> + ?shutdown(no_node) end. send_challenge_ack(Socket, Digest) -> @@ -627,13 +620,6 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of - [$v, Result, A, B, C, D] -> - case Result of - 0 -> - {alive, Socket, ?u32(A, B, C, D)}; - _ -> - {error, duplicate_name} - end; [$y, Result, A, B] -> case Result of 0 -> @@ -654,7 +640,7 @@ wait_for_reg_reply(Socket, SoFar) -> end. -register_node(NodeName, ListenSocket, VLow, VHigh) -> +register(NodeName, ListenSocket, VLow, VHigh) -> {ok,{_,TcpPort}} = inet:sockname(ListenSocket), case do_register_node(NodeName, TcpPort, VLow, VHigh) of {alive, Socket, _Creation} -> diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index e095e589a3..3bc8e6e828 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -4514,15 +4514,18 @@ run_large_file_test(Config, Run, Name) -> {{unix,sunos},OsVersion} when OsVersion < {5,5,1} -> {skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"}; {{unix,_},_} -> - N = disc_free(proplists:get_value(priv_dir, Config)), - io:format("Free disk: ~w KByte~n", [N]), - if N < 5 * (1 bsl 20) -> - %% Less than 5 GByte free - {skip,"Less than 5 GByte free"}; - true -> - do_run_large_file_test(Config, Run, Name) - end; - _ -> + case disc_free(proplists:get_value(priv_dir, Config)) of + error -> + {skip, "Failed to query disk space for priv_dir. " + "Is it on a remote file system?~n"}; + N when N >= 5 * (1 bsl 20) -> + ct:pal("Free disk: ~w KByte~n", [N]), + do_run_large_file_test(Config, Run, Name); + N when N < 5 * (1 bsl 20) -> + ct:pal("Free disk: ~w KByte~n", [N]), + {skip,"Less than 5 GByte free"} + end; + _ -> {skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"} end. @@ -4556,12 +4559,18 @@ do_run_large_file_test(Config, Run, Name0) -> disc_free(Path) -> Data = disksup:get_disk_data(), - {_,Tot,Perc} = hd(lists:filter( - fun({P,_Size,_Full}) -> - lists:prefix(filename:nativename(P), - filename:nativename(Path)) - end, lists:reverse(lists:sort(Data)))), - round(Tot * (1-(Perc/100))). + + %% What partitions could Data be mounted on? + Partitions = + [D || {P, _Tot, _Perc}=D <- Data, + lists:prefix(filename:nativename(P), filename:nativename(Path))], + + %% Sorting in descending order places the partition with the most specific + %% path first. + case lists:sort(fun erlang:'>='/2, Partitions) of + [{_,Tot, Perc} | _] -> round(Tot * (1-(Perc/100))); + [] -> error + end. memsize() -> {Tot,_Used,_} = memsup:get_memory_data(), diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index cbec8d430c..6b545fa414 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -46,15 +46,16 @@ %% a temporary local nameserver BIND 8 or 9 that must be installed %% on your machine. %% -%% For example, on Ubuntu 14.04, as root: +%% For example, on Ubuntu 16.04 / 18.04, as root: %% apt-get install bind9 %% Now, that is not enough since Apparmor will not allow %% the nameserver daemon /usr/sbin/named to read from the test directory. %% Assuming that you run tests in /ldisk/daily_build, and still on -%% Ubuntu 14.04, make /usr/apparmor.d/local/usr.sbin.named contain: +%% Ubuntu 14.04, make /etc/apparmor.d/local/usr.sbin.named contain: %% /ldisk/daily_build/** r, %% And yes; the trailing comma must be there... - +%% And yes; create the file if it does not exist. +%% And yes; restart the apparmor daemon using "service apparmor restart" suite() -> diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index 0c5516f82b..16ab0e97fc 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -71,6 +71,14 @@ init_per_group(_Group, Config) -> end_per_group(_Group, _Config) -> ok. +init_per_testcase(reopen_changed_log=TC, Config) -> + case os:type() of + {win32,_} -> + {skip,"This test can only work with inodes, i.e. not on Windows"}; + _ -> + ct:print("********** ~w **********", [TC]), + Config + end; init_per_testcase(TestHooksCase, Config) when TestHooksCase == write_failure; TestHooksCase == sync_failure -> diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 7bebe1ba70..b1ae513223 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 6.3 +KERNEL_VSN = 6.3.1 diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index cbf7db28f0..8b79fca1d7 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -743,8 +743,9 @@ non_transaction(OldState, Fun, Args, ActivityKind, Mod) -> {aborted, Reason} -> mnesia:abort(Reason); Res -> Res catch - throw:Throw -> throw(Throw); - _:Reason -> exit(Reason) + throw:Throw -> throw(Throw); + error:Reason:ST -> exit({Reason, ST}); + exit:Reason -> exit(Reason) after case OldState of undefined -> erase(mnesia_activity_state); diff --git a/lib/mnesia/test/mnesia_dirty_access_test.erl b/lib/mnesia/test/mnesia_dirty_access_test.erl index 67ef1fe901..984f43582c 100644 --- a/lib/mnesia/test/mnesia_dirty_access_test.erl +++ b/lib/mnesia/test/mnesia_dirty_access_test.erl @@ -48,7 +48,7 @@ del_table_copy_1/1, del_table_copy_2/1, del_table_copy_3/1, add_table_copy_1/1, add_table_copy_2/1, add_table_copy_3/1, add_table_copy_4/1, move_table_copy_1/1, move_table_copy_2/1, - move_table_copy_3/1, move_table_copy_4/1]). + move_table_copy_3/1, move_table_copy_4/1, dirty_error_stacktrace/1]). -export([update_trans/3]). @@ -64,7 +64,7 @@ all() -> {group, dirty_update_counter}, {group, dirty_delete}, {group, dirty_delete_object}, {group, dirty_match_object}, {group, dirty_index}, - {group, dirty_iter}, {group, admin_tests}]. + {group, dirty_iter}, {group, admin_tests}, dirty_error_stacktrace]. groups() -> [{dirty_write, [], @@ -114,6 +114,36 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Errors in dirty activity should have stacktrace +dirty_error_stacktrace(Config) -> + %% Custom errors should have stacktrace + try + mnesia:async_dirty(fun() -> error(custom_error) end) + catch + exit:{custom_error, _} -> ok + end, + + %% Undef error should have unknown module and function in the stacktrace + try + mnesia:async_dirty(fun() -> unknown_module:unknown_fun(arg) end) + catch + exit:{undef, [{unknown_module, unknown_fun, [arg], []} | _]} -> ok + end, + + %% Exists don't have stacktrace + try + mnesia:async_dirty(fun() -> exit(custom_error) end) + catch + exit:custom_error -> ok + end, + + %% Aborts don't have a stacktrace (unfortunately) + try + mnesia:async_dirty(fun() -> mnesia:abort(custom_abort) end) + catch + exit:{aborted, custom_abort} -> ok + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Write records dirty 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/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 3f5d9fee3e..ad8fb11beb 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -124,10 +124,6 @@ file(Config) when is_list(Config) -> "Erlang code.\n">>, ?line ok = file:write_file(Filename, Mini), ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = - leex:file(Filename, [{scannerfile,"//"} | Ret]), - ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = - leex:file(Filename, [{includefile,"//"} | Ret]), - ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = leex:file(Filename, [{includefile,"/ /"} | Ret]), LeexPre = filename:join(Dir, "leexinc.hrl"), @@ -191,7 +187,6 @@ compile(Config) when is_list(Config) -> "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" "Erlang code.\n">>, ?line ok = file:write_file(Filename, Mini), - ?line error = leex:compile(Filename, "//", #options{}), ?line ok = leex:compile(Filename, Scannerfile, #options{}), file:delete(Scannerfile), file:delete(Filename), diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index f6bc0dc797..d83dd24f41 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -35,6 +35,26 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 1.6.6</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Back port of bug fix ERL-893 from OTP-22 and document + enhancements that will solve dialyzer warnings for users + of the ssl application.</p> + <p> + This change also affects public_key, eldap (and inet + doc).</p> + <p> + Own Id: OTP-15785 Aux Id: ERL-929, ERL-893, PR-2215 </p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.6.5</title> <section><title>Improvements and New Features</title> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index fb81ea68a4..12bb0b21b0 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -286,7 +286,9 @@ entries as ASN.1 DER encoded entities.</fsummary> <desc> <p>Decodes PEM binary data and returns entries as ASN.1 DER encoded entities.</p> - <p>Example <c>{ok, PemBin} = file:read_file("cert.pem").</c></p> + <p>Example <c>{ok, PemBin} = file:read_file("cert.pem"). + PemEntries = public_key:pem_decode(PemBin). + </c></p> </desc> </func> @@ -813,7 +815,8 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <p>The <c>{OtherRefId,term()}</c> is defined by the user and is passed to the <c>match_fun</c>, if defined. If the term in <c>OtherRefId</c> is a binary, it will be converted to a string. </p> - <p>The <c>ip</c> Reference ID takes an <seealso marker="inet:inet#type-ip_address">inet:ip_address()</seealso> + <p>The <c>ip</c> Reference ID takes an + <seealso marker="kernel:inet#type-ip_address">inet:ip_address()</seealso> or an ip address in string format (E.g "10.0.1.1" or "1234::5678:9012") as second element. </p> <p>The options are:</p> diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 61a1239d26..12c61e158f 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -1187,6 +1187,8 @@ sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> parameters = Parms}. rsa_digest_oid(sha1) -> ?'sha1WithRSAEncryption'; +rsa_digest_oid(sha) -> + ?'sha1WithRSAEncryption'; rsa_digest_oid(sha512) -> ?'sha512WithRSAEncryption'; rsa_digest_oid(sha384) -> @@ -1198,6 +1200,8 @@ rsa_digest_oid(md5) -> ecdsa_digest_oid(sha1) -> ?'ecdsa-with-SHA1'; +ecdsa_digest_oid(sha) -> + ?'ecdsa-with-SHA1'; ecdsa_digest_oid(sha512) -> ?'ecdsa-with-SHA512'; ecdsa_digest_oid(sha384) -> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 47c5dbb95a..47266c514c 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -112,6 +112,7 @@ -type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | auth_keys. -type digest_type() :: none % None is for backwards compatibility + | sha1 % Backwards compatibility | crypto:rsa_digest_type() | crypto:dss_digest_type() | crypto:ecdsa_digest_type(). @@ -406,8 +407,7 @@ decrypt_private(CipherText, Options) when is_binary(CipherText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:private_decrypt(rsa, CipherText, format_rsa_private_key(Key), Padding). + crypto:private_decrypt(rsa, CipherText, format_rsa_private_key(Key), default_options(Options)). %%-------------------------------------------------------------------- %% Description: Public key decryption using the public key. @@ -428,8 +428,7 @@ decrypt_public(CipherText, Key) -> PlainText :: binary() . decrypt_public(CipherText, #'RSAPublicKey'{modulus = N, publicExponent = E}, Options) when is_binary(CipherText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:public_decrypt(rsa, CipherText,[E, N], Padding). + crypto:public_decrypt(rsa, CipherText,[E, N], default_options(Options)). %%-------------------------------------------------------------------- %% Description: Public key encryption using the public key. @@ -451,8 +450,7 @@ encrypt_public(PlainText, Key) -> CipherText :: binary() . encrypt_public(PlainText, #'RSAPublicKey'{modulus=N,publicExponent=E}, Options) when is_binary(PlainText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:public_encrypt(rsa, PlainText, [E,N], Padding). + crypto:public_encrypt(rsa, PlainText, [E,N], default_options(Options)). %%-------------------------------------------------------------------- %% @@ -480,8 +478,7 @@ encrypt_private(PlainText, when is_binary(PlainText), is_integer(N), is_integer(E), is_integer(D), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:private_encrypt(rsa, PlainText, format_rsa_private_key(Key), Padding). + crypto:private_encrypt(rsa, PlainText, format_rsa_private_key(Key), default_options(Options)). %%-------------------------------------------------------------------- %% Description: List available group sizes among the pre-computed dh groups @@ -1234,6 +1231,33 @@ pkix_test_root_cert(Name, Opts) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +default_options([]) -> + [{rsa_padding, rsa_pkcs1_padding}]; +default_options(Opts) -> + case proplists:get_value(rsa_pad, Opts) of + undefined -> + case proplists:get_value(rsa_padding, Opts) of + undefined -> + case lists:dropwhile(fun erlang:is_tuple/1, Opts) of + [Pad|_] -> + set_padding(Pad, Opts); + [] -> + set_padding(rsa_pkcs1_padding, Opts) + end; + Pad -> + set_padding(Pad, Opts) + end; + Pad -> + set_padding(Pad, Opts) + end. + +set_padding(Pad, Opts) -> + [{rsa_padding,Pad} | [{T,V} || {T,V} <- Opts, + T =/= rsa_padding, + T =/= rsa_pad] + ]. + + format_sign_key(Key = #'RSAPrivateKey'{}) -> {rsa, format_rsa_private_key(Key)}; format_sign_key(#'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index 11c06fb158..c68806d856 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 1.6.5 +PUBLIC_KEY_VSN = 1.6.6 diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile index 7338bdf016..fd62588f5c 100644 --- a/lib/sasl/src/Makefile +++ b/lib/sasl/src/Makefile @@ -61,7 +61,11 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- + ERL_COMPILE_FLAGS += -I../../stdlib/include -Werror +ifeq ($(USE_ESOCK), yes) +ERL_COMPILE_FLAGS += -DUSE_ESOCK=true +endif # ---------------------------------------------------- diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index c2c91fd667..b5a6b44f93 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -33,6 +33,7 @@ -export([read_application/4]). -export([make_hybrid_boot/4]). +-export([preloaded/0]). % Exported just for testing -import(lists, [filter/2, keysort/2, keysearch/3, map/2, reverse/1, append/1, foldl/3, member/2, foreach/2]). @@ -45,6 +46,13 @@ -compile({inline,[{badarg,2}]}). +-ifdef(USE_ESOCK). +-define(ESOCK_MODS, [socket]). +-else. +-define(ESOCK_MODS, []). +-endif. + + %%----------------------------------------------------------------- %% Create a boot script from a release file. %% Options is a list of {path, Path} | silent | local @@ -1566,7 +1574,7 @@ preloaded() -> erts_code_purger,erts_dirty_process_signal_handler, erts_internal,erts_literal_area_collector, init,net,persistent_term,prim_buffer,prim_eval,prim_file, - prim_inet,prim_zip,socket,zlib]. + prim_inet,prim_zip] ++ ?ESOCK_MODS ++ [zlib]. %%______________________________________________________________________ %% Kernel processes; processes that are specially treated by the init 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/include/snmp_types.hrl b/lib/snmp/include/snmp_types.hrl index ffe30996dc..eff17a13a3 100644 --- a/lib/snmp/include/snmp_types.hrl +++ b/lib/snmp/include/snmp_types.hrl @@ -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. @@ -349,6 +349,9 @@ -define(view_included, 1). -define(view_excluded, 2). +-define(view_wildcard, 0). +-define(view_exact, 1). + %%----------------------------------------------------------------- %% From SNMPv2-SMI diff --git a/lib/snmp/src/agent/depend.mk b/lib/snmp/src/agent/depend.mk index 8eba50fa3b..49c7669e41 100644 --- a/lib/snmp/src/agent/depend.mk +++ b/lib/snmp/src/agent/depend.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. 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. @@ -24,6 +24,9 @@ $(EBIN)/snmpa_authentication_service.$(EMULATOR): \ $(EBIN)/snmpa_error_report.$(EMULATOR): \ snmpa_error_report.erl +$(EBIN)/snmpa_get_mechanism.$(EMULATOR): \ + snmpa_get_mechanism.erl + $(EBIN)/snmpa_network_interface.$(EMULATOR): \ snmpa_network_interface.erl @@ -78,6 +81,20 @@ $(EBIN)/snmpa_error_logger.$(EMULATOR): \ snmpa_error_report.erl \ snmpa_error_logger.erl +$(EBIN)/snmpa_set.$(EMULATOR): \ + snmpa_set_mechanism.erl \ + snmpa_set.erl \ + ../misc/snmp_verbosity.hrl + +$(EBIN)/snmpa_get.$(EMULATOR): \ + snmpa_get_mechanism.erl \ + snmpa_get.erl \ + ../misc/snmp_verbosity.hrl + +$(EBIN)/snmpa_get_lib.$(EMULATOR): \ + snmpa_get_lib.erl \ + ../misc/snmp_verbosity.hrl + $(EBIN)/snmpa_local_db.$(EMULATOR): \ snmpa_local_db.erl \ ../misc/snmp_debug.hrl \ diff --git a/lib/snmp/src/agent/modules.mk b/lib/snmp/src/agent/modules.mk index 0f8615588a..49cc158c2e 100644 --- a/lib/snmp/src/agent/modules.mk +++ b/lib/snmp/src/agent/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. 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. @@ -22,6 +22,7 @@ BEHAVIOUR_MODULES = \ snmpa_authentication_service \ snmpa_discovery_handler \ snmpa_error_report \ + snmpa_get_mechanism \ snmpa_mib_storage \ snmpa_mib_data \ snmpa_network_interface \ @@ -30,12 +31,24 @@ BEHAVIOUR_MODULES = \ snmpa_notification_filter \ snmpa_set_mechanism +MIB_MODULES = \ + snmp_community_mib \ + snmp_framework_mib \ + snmp_notification_mib \ + snmp_standard_mib \ + snmp_target_mib \ + snmp_user_based_sm_mib \ + snmp_view_based_acm_mib + # snmpa is "plain" interface module but also defines some agent specific types # and therefor must be compiled before the modules that use them, including # the behaviour modules... +# Some of the MIB modules also define types used elsewhere and therefor +# has to be built before the other mods. # snmpa_mib_data_ttln MODULES = \ snmpa \ + $(MIB_MODULES) \ $(BEHAVIOUR_MODULES) \ snmpa_acm \ snmpa_agent \ @@ -46,6 +59,8 @@ MODULES = \ snmpa_error \ snmpa_error_io \ snmpa_error_logger \ + snmpa_get \ + snmpa_get_lib \ snmpa_local_db \ snmpa_mib_storage_ets \ snmpa_mib_storage_dets \ @@ -66,17 +81,10 @@ MODULES = \ snmpa_trap \ snmpa_usm \ snmpa_vacm \ - snmp_community_mib \ - snmp_framework_mib \ snmp_generic \ snmp_generic_mnesia \ snmp_index \ - snmp_notification_mib \ - snmp_shadow_table \ - snmp_standard_mib \ - snmp_target_mib \ - snmp_user_based_sm_mib \ - snmp_view_based_acm_mib + snmp_shadow_table INTERNAL_HRL_FILES = \ diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 02415e8036..c6eeb7cea2 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-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. @@ -37,6 +37,12 @@ %% -export([emask2imask/1]). +-export_type([ + mibview/0, + internal_view_mask/0, + internal_view_mask_element/0, + internal_view_type/0 + ]). -include("snmp_types.hrl"). -include("SNMPv2-TC.hrl"). @@ -53,7 +59,13 @@ -type internal_view_mask() :: null | [internal_view_mask_element()]. --type internal_view_mask_element() :: 0 | 1. +-type internal_view_mask_element() :: ?view_wildcard | + ?view_exact. +-type internal_view_type() :: ?view_included | ?view_excluded. + +-type mibview() :: [{SubTree :: snmp:oid(), + Mask :: internal_view_mask(), + Type :: internal_view_type()}]. -type external_view_mask() :: octet_string(). % At most length of 16 octet -type octet_string() :: [octet()]. diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 458b88359b..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. @@ -28,7 +28,8 @@ %% External exports -export([start_link/4, start_link/5, stop/1]). --export([subagent_set/2, +-export([subagent_get/3, subagent_get_next/3, + subagent_set/2, load_mibs/3, unload_mibs/3, which_mibs/1, whereis_mib/2, info/1, register_subagent/3, unregister_subagent/2, @@ -362,12 +363,19 @@ do_init(Prio, Parent, Ref, Options) -> "~n Options: ~p",[Prio, Parent, Ref, Options]), Mibs = get_mibs(Options), + SetModule = get_set_mechanism(Options), put(set_module, SetModule), + ?vtrace("set-module: ~w", [SetModule]), + + GetModule = get_get_mechanism(Options), + put(get_module, GetModule), + ?vtrace("get-module: ~w", [GetModule]), %% OTP-3324. For AXD301. AuthModule = get_authentication_service(Options), put(auth_module, AuthModule), + ?vtrace("auth-module: ~w", [AuthModule]), MultiT = get_multi_threaded(Options), Vsns = get_versions(Options), @@ -1133,7 +1141,7 @@ handle_call({subagent_get_next, MibView, Varbinds, PduData}, _From, S) -> "~n PduData: ~p", [MibView,Varbinds,PduData]), put_pdu_data(PduData), - {reply, do_get_next(MibView, Varbinds, infinity), S}; + {reply, do_get_next(MibView, Varbinds), S}; handle_call({subagent_set, Arguments, PduData}, _From, S) -> ?vlog("[handle_call] subagent set:" "~n Arguments: ~p" @@ -1174,7 +1182,7 @@ handle_call({get_next, Vars, Context}, _From, S) -> ?vdebug("Varbinds: ~p",[Varbinds]), MibView = snmpa_acm:get_root_mib_view(), Reply = - case do_get_next(MibView, Varbinds, infinity) of + case do_get_next(MibView, Varbinds) of {noError, 0, NewVarbinds} -> Vbs = lists:keysort(#varbind.org_index, NewVarbinds), [{Oid,Val} || #varbind{oid = Oid, value = Val} <- Vbs]; @@ -1786,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... @@ -1814,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... @@ -2535,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}, @@ -2558,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, infinity)), - ?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', @@ -2582,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. @@ -2650,8 +2693,7 @@ validate_next_v1_2([Vb | _Vbs], _MibView, _Res) {noSuchName, Vb#varbind.org_index}; validate_next_v1_2([Vb | Vbs], MibView, Res) when Vb#varbind.variabletype =:= 'Counter64' -> - case validate_next_v1( - do_get_next(MibView, [mk_next_oid(Vb)], infinity), MibView) of + case validate_next_v1( do_get_next(MibView, [mk_next_oid(Vb)]), MibView) of {noError, 0, [NVb]} -> validate_next_v1_2(Vbs, MibView, [NVb | Res]); {Error, Index, _OrgVb} -> @@ -2693,6 +2735,20 @@ mk_next_oid(Vb) -> %%%----------------------------------------------------------------- %%----------------------------------------------------------------- +%% Func: do_get/2 +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(UnsortedVarbinds, IsNotification) -> + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get(UnsortedVarbinds, IsNotification, Extra). + + +%%----------------------------------------------------------------- %% Func: do_get/3 %% Purpose: do_get handles "getRequests". %% Pre: incoming varbinds have type == 'NULL', value == unSpecified @@ -2700,390 +2756,24 @@ mk_next_oid(Vb) -> %% {ErrorStatus, ErrorIndex, []} %%----------------------------------------------------------------- -%% If this function is called from a worker-process, we *may* -%% need to tunnel into the master-agent and let it do the -%% work +%% If this function is called from a worker-process (or other process), +%% we *may* need to tunnel into the master-agent and let it do the work. do_get(MibView, UnsortedVarbinds, IsNotification) -> - do_get(MibView, UnsortedVarbinds, IsNotification, false). + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get(MibView, UnsortedVarbinds, IsNotification, Extra). do_get(MibView, UnsortedVarbinds, IsNotification, ForceMaster) -> - ?vtrace("do_get -> entry with" - "~n MibView: ~p" - "~n UnsortedVarbinds: ~p" - "~n IsNotification: ~p", - [MibView, UnsortedVarbinds, IsNotification]), case (whereis(snmp_master_agent) =:= self()) of false when (ForceMaster =:= true) -> - %% I am a lowly worker process, handoff to the master agent PduData = get_pdu_data(), call(snmp_master_agent, {do_get, MibView, UnsortedVarbinds, IsNotification, PduData}); - - _ -> - %% This is me, the master, so go ahead - {OutSideView, InSideView} = - split_vbs_view(UnsortedVarbinds, MibView), - {Error, Index, NewVbs} = - do_get(InSideView, IsNotification), - {Error, Index, NewVbs ++ OutSideView} - - end. - - -split_vbs_view(Vbs, MibView) -> - ?vtrace("split the varbinds view", []), - split_vbs_view(Vbs, MibView, [], []). - -split_vbs_view([Vb | Vbs], MibView, Out, In) -> - case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of - true -> split_vbs_view(Vbs, MibView, Out, [Vb | In]); - false -> split_vbs_view(Vbs, MibView, - [Vb#varbind{value = noSuchObject} | Out], In) - end; -split_vbs_view([], _MibView, Out, In) -> - {Out, In}. - -do_get(UnsortedVarbinds, IsNotification) -> - {MyVarbinds, SubagentVarbinds} = sort_varbindlist(UnsortedVarbinds), - case do_get_local(MyVarbinds, [], IsNotification) of - {noError, 0, NewMyVarbinds} -> - case do_get_subagents(SubagentVarbinds, IsNotification) of - {noError, 0, NewSubagentVarbinds} -> - {noError, 0, NewMyVarbinds ++ NewSubagentVarbinds}; - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []} - end; - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []} - end. - -%%----------------------------------------------------------------- -%% Func: do_get_local/3 -%% Purpose: Loop the variablebindings list. We know that each varbind -%% in that list belongs to us. -%% Returns: {noError, 0, ListOfNewVarbinds} | -%% {ErrorStatus, ErrorIndex, []} -%%----------------------------------------------------------------- -do_get_local([Vb | Vbs], Res, IsNotification) -> - case try_get(Vb, IsNotification) of - NewVb when is_record(NewVb, varbind) -> - do_get_local(Vbs, [NewVb | Res], IsNotification); - ListOfNewVb when is_list(ListOfNewVb) -> - do_get_local(Vbs, lists:append(ListOfNewVb, Res), IsNotification); - {error, Error, OrgIndex} -> - {Error, OrgIndex, []} - end; -do_get_local([], Res, _IsNotification) -> - {noError, 0, Res}. - -%%----------------------------------------------------------------- -%% Func: do_get_subagents/2 -%% Purpose: Loop the list of varbinds for different subagents. -%% For each of them, call sub_agent_get to retreive -%% the values for them. -%% Returns: {noError, 0, ListOfNewVarbinds} | -%% {ErrorStatus, ErrorIndex, []} -%%----------------------------------------------------------------- -do_get_subagents(SubagentVarbinds, IsNotification) -> - do_get_subagents(SubagentVarbinds, [], IsNotification). -do_get_subagents([{SubAgentPid, SAVbs} | Tail], Res, IsNotification) -> - {_SAOids, Vbs} = sa_split(SAVbs), - case catch subagent_get(SubAgentPid, Vbs, IsNotification) of - {noError, 0, NewVbs} -> - do_get_subagents(Tail, lists:append(NewVbs, Res), IsNotification); - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []}; - {'EXIT', Reason} -> - user_err("Lost contact with subagent (get) ~w. Using genErr", - [Reason]), - {genErr, 0, []} - end; -do_get_subagents([], Res, _IsNotification) -> - {noError, 0, Res}. - - -%%----------------------------------------------------------------- -%% Func: try_get/2 -%% Returns: {error, ErrorStatus, OrgIndex} | -%% #varbind | -%% List of #varbind -%%----------------------------------------------------------------- -try_get(IVb, IsNotification) when is_record(IVb, ivarbind) -> - ?vtrace("try_get(ivarbind) -> entry with" - "~n IVb: ~p", [IVb]), - get_var_value_from_ivb(IVb, IsNotification); -try_get({TableOid, TableVbs}, IsNotification) -> - ?vtrace("try_get(table) -> entry with" - "~n TableOid: ~p" - "~n TableVbs: ~p", [TableOid, TableVbs]), - [#ivarbind{mibentry = MibEntry}|_] = TableVbs, - {NoAccessVbs, AccessVbs} = - check_all_table_vbs(TableVbs, IsNotification, [], []), - case get_tab_value_from_mib(MibEntry, TableOid, AccessVbs) of - {error, ErrorStatus, OrgIndex} -> - {error, ErrorStatus, OrgIndex}; - NVbs -> - NVbs ++ NoAccessVbs - end. - -%%----------------------------------------------------------------- -%% Make sure all requested columns are accessible. -%%----------------------------------------------------------------- -check_all_table_vbs([IVb| IVbs], IsNotification, NoA, A) -> - #ivarbind{mibentry = Me, varbind = Vb} = IVb, - case Me#me.access of - 'not-accessible' -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - 'accessible-for-notify' when IsNotification =:= false -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - 'write-only' -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - _ -> - check_all_table_vbs(IVbs, IsNotification, NoA, [IVb | A]) - end; -check_all_table_vbs([], _IsNotification, NoA, A) -> {NoA, A}. - -%%----------------------------------------------------------------- -%% Returns: {error, ErrorStatus, OrgIndex} | -%% #varbind -%%----------------------------------------------------------------- -get_var_value_from_ivb(IVb, IsNotification) - when IVb#ivarbind.status =:= noError -> - ?vtrace("get_var_value_from_ivb(noError) -> entry", []), - #ivarbind{mibentry = Me, varbind = Vb} = IVb, - #varbind{org_index = OrgIndex, oid = Oid} = Vb, - case Me#me.access of - 'not-accessible' -> - Vb#varbind{value = noSuchInstance}; - 'accessible-for-notify' when IsNotification =:= false -> - Vb#varbind{value = noSuchInstance}; - 'write-only' -> - Vb#varbind{value = noSuchInstance}; - _ -> - case get_var_value_from_mib(Me, Oid) of - {value, Type, Value} -> - Vb#varbind{variabletype = Type, value = Value}; - {error, ErrorStatus} -> - {error, ErrorStatus, OrgIndex} - end - end; -get_var_value_from_ivb(#ivarbind{status = Status, varbind = Vb}, _) -> - ?vtrace("get_var_value_from_ivb(~p) -> entry", [Status]), - Vb#varbind{value = Status}. - -%%----------------------------------------------------------------- -%% Func: get_var_value_from_mib/1 -%% Purpose: -%% Returns: {error, ErrorStatus} | -%% {value, Type, Value} -%%----------------------------------------------------------------- -%% Pre: Oid is a correct instance Oid (lookup checked that). -%% Returns: A correct return value (see make_value_a_correct_value) -get_var_value_from_mib(#me{entrytype = variable, - asn1_type = ASN1Type, - mfa = {Mod, Func, Args}}, - _Oid) -> - ?vtrace("get_var_value_from_mib(variable) -> entry when" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p", [Mod, Func, Args]), - Result = (catch dbg_apply(Mod, Func, [get | Args])), - % mib shall return {value, <a-nice-value-within-range>} | - % {noValue, noSuchName} (v1) | - % {noValue, noSuchObject | noSuchInstance} (v2, v1) - % everything else (including 'genErr') will generate 'genErr'. - make_value_a_correct_value(Result, ASN1Type, {Mod, Func, Args}); - -get_var_value_from_mib(#me{entrytype = table_column, - oid = MeOid, - asn1_type = ASN1Type, - mfa = {Mod, Func, Args}}, - Oid) -> - ?vtrace("get_var_value_from_mib(table_column) -> entry when" - "~n MeOid: ~p" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p" - "~n Oid: ~p", [MeOid, Mod, Func, Args, Oid]), - Col = lists:last(MeOid), - Indexes = snmp_misc:diff(Oid, MeOid), - [Result] = (catch dbg_apply(Mod, Func, [get, Indexes, [Col] | Args])), - make_value_a_correct_value(Result, ASN1Type, - {Mod, Func, Args, Indexes, Col}). - - -%% For table operations we need to pass RestOid down to the table-function. -%% Its up to the table-function to check for noSuchInstance (ex: a -%% non-existing row). -%% Returns: {error, ErrorStatus, OrgIndex} | -%% {value, Type, Value} -get_tab_value_from_mib(#me{mfa = {Mod, Func, Args}}, TableOid, TableVbs) -> - ?vtrace("get_tab_value_from_mib -> entry when" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p", [Mod, Func, Args]), - TableOpsWithShortOids = deletePrefixes(TableOid, TableVbs), - SortedVBsRows = snmpa_svbl:sort_varbinds_rows(TableOpsWithShortOids), - case get_value_all_rows(SortedVBsRows, Mod, Func, Args, []) of - {Error, Index} -> - #ivarbind{varbind = Vb} = lists:nth(Index, TableVbs), - {error, Error, Vb#varbind.org_index}; - ListOfValues -> - merge_varbinds_and_value(TableVbs, ListOfValues) + _ -> + do_get(MibView, UnsortedVarbinds, IsNotification) end. -%%----------------------------------------------------------------- -%% Values is a scrambled list of {CorrectValue, Index}, where Index -%% is index into the #ivarbind list. So for each Value, we must -%% find the corresponding #ivarbind, and merge them into a new -%% #varbind. -%% The Values list comes from validate_tab_res. -%%----------------------------------------------------------------- -merge_varbinds_and_value(IVbs, [{{value, Type, Value}, Index} | Values]) -> - #ivarbind{varbind = Vb} = lists:nth(Index, IVbs), - [Vb#varbind{variabletype = Type, value = Value} | - merge_varbinds_and_value(IVbs, Values)]; -merge_varbinds_and_value(_, []) -> []. - -get_value_all_rows([{[], OrgCols} | Rows], Mod, Func, Args, Res) -> - ?vtrace("get_value_all_rows -> entry when" - "~n OrgCols: ~p", [OrgCols]), - Cols = [{{value, noValue, noSuchInstance}, Index} || - {_Col, _ASN1Type, Index} <- OrgCols], - NewRes = lists:append(Cols, Res), - get_value_all_rows(Rows, Mod, Func, Args, NewRes); -get_value_all_rows([{RowIndex, OrgCols} | Rows], Mod, Func, Args, Res) -> - ?vtrace("get_value_all_rows -> entry when" - "~n RowIndex: ~p" - "~n OrgCols: ~p", [RowIndex, OrgCols]), - {DOrgCols, Dup} = remove_duplicates(OrgCols), - Cols = delete_index(DOrgCols), - Result = (catch dbg_apply(Mod, Func, [get, RowIndex, Cols | Args])), - case validate_tab_res(Result, DOrgCols, {Mod, Func, Args}) of - Values when is_list(Values) -> - NVals = restore_duplicates(Dup, Values), - NewRes = lists:append(NVals, Res), - get_value_all_rows(Rows, Mod, Func, Args, NewRes); - {error, ErrorStatus, Index} -> - validate_err(row_set, {ErrorStatus, Index}, {Mod, Func, Args}) - end; -get_value_all_rows([], _Mod, _Func, _Args, Res) -> - ?vtrace("get_value_all_rows -> entry when done" - "~n Res: ~p", [Res]), - Res. - -%%----------------------------------------------------------------- -%% Returns: list of {ShortOid, ASN1TYpe} -%%----------------------------------------------------------------- -deletePrefixes(Prefix, [#ivarbind{varbind = Varbind, mibentry = ME} | Vbs]) -> - #varbind{oid = Oid} = Varbind, - [{snmp_misc:diff(Oid, Prefix), ME#me.asn1_type} | - deletePrefixes(Prefix, Vbs)]; -deletePrefixes(_Prefix, []) -> []. - -%%----------------------------------------------------------------- -%% Args: {RowIndex, list of {ShortOid, ASN1Type}} -%% Returns: list of Col -%%----------------------------------------------------------------- -delete_index([{Col, _Val, _OrgIndex} | T]) -> - [Col | delete_index(T)]; -delete_index([]) -> []. - -%%----------------------------------------------------------------- -%% This function is called before 'get' on a table, and removes -%% any duplicate columns. It returns {Cols, DupInfo}. The Cols -%% are the unique columns. The instrumentation function is -%% called to get the values. These values, together with the -%% DupInfo, is later passed to restore_duplicates, which uses -%% the retrieved values to reconstruct the original column list, -%% but with the retrieved value for each column. -%%----------------------------------------------------------------- -remove_duplicates(Cols) -> - remove_duplicates(Cols, [], []). - - -remove_duplicates([{Col, V1, OrgIdx1}, {Col, V2, OrgIdx2} | T], NCols, Dup) -> - remove_duplicates([{Col, V1, OrgIdx1} | T], NCols, - [{Col, V2, OrgIdx2} | Dup]); -remove_duplicates([Col | T], NCols, Dup) -> - remove_duplicates(T, [Col | NCols], Dup); -remove_duplicates([], NCols, Dup) -> - {lists:reverse(NCols), lists:reverse(Dup)}. - -restore_duplicates([], Cols) -> - [{Val, OrgIndex} || {_Col, Val, OrgIndex} <- Cols]; -restore_duplicates([{Col, _Val2, OrgIndex2} | Dup], - [{Col, NVal, OrgIndex1} | Cols]) -> - [{NVal, OrgIndex2} | - restore_duplicates(Dup, [{Col, NVal, OrgIndex1} | Cols])]; -restore_duplicates(Dup, [{_Col, Val, OrgIndex} | T]) -> - [{Val, OrgIndex} | restore_duplicates(Dup, T)]. - -%% Maps the column number to Index. -% col_to_index(0, _) -> 0; -% col_to_index(Col, [{Col, _, Index}|_]) -> -% Index; -% col_to_index(Col, [_|Cols]) -> -% col_to_index(Col, Cols). - -%%----------------------------------------------------------------- -%% Three cases: -%% 1) All values ok -%% 2) table_func returned {Error, ...} -%% 3) Some value in Values list is erroneous. -%% Args: Value is a list of values from table_func(get..) -%% OrgCols is a list with {Col, ASN1Type, OrgIndex} -%% each element in Values and OrgCols correspond to each -%% other. -%%----------------------------------------------------------------- -validate_tab_res(Values, OrgCols, Mfa) when is_list(Values) -> - {_Col, _ASN1Type, OneIdx} = hd(OrgCols), - validate_tab_res(Values, OrgCols, Mfa, [], OneIdx); -validate_tab_res({noValue, Error}, OrgCols, Mfa) -> - Values = lists:duplicate(length(OrgCols), {noValue, Error}), - validate_tab_res(Values, OrgCols, Mfa); -validate_tab_res({genErr, Col}, OrgCols, Mfa) -> - case lists:keysearch(Col, 1, OrgCols) of - {value, {_Col, _ASN1Type, Index}} -> - {error, genErr, Index}; - _ -> - user_err("Invalid column in {genErr, ~w} from ~w (get)", - [Col, Mfa]), - [{_Col, _ASN1Type, Index} | _] = OrgCols, - {error, genErr, Index} - end; -validate_tab_res(genErr, [{_Col, __ASN1Type, Index} | _OrgCols], _Mfa) -> - {error, genErr, Index}; -validate_tab_res(Error, [{_Col, _ASN1Type, Index} | _OrgCols], Mfa) -> - user_err("Invalid return value ~w from ~w (get)",[Error, Mfa]), - {error, genErr, Index}. - -validate_tab_res([Value | Values], - [{Col, ASN1Type, Index} | OrgCols], - Mfa, Res, I) -> - %% This one makes it possible to return a list of genErr, which - %% is not allowed according to the manual. But that's ok, as - %% everything else will generate a genErr! (the only problem is - %% that it won't generate a user_error). - case make_value_a_correct_value(Value, ASN1Type, Mfa) of - {error, ErrorStatus} -> - {error, ErrorStatus, Index}; - CorrectValue -> - NewRes = [{Col, CorrectValue, Index} | Res], - validate_tab_res(Values, OrgCols, Mfa, NewRes, I) - end; -validate_tab_res([], [], _Mfa, Res, _I) -> - lists:reverse(Res); -validate_tab_res([], [{_Col, _ASN1Type, Index}|_], Mfa, _Res, _I) -> - user_err("Too few values returned from ~w (get)", [Mfa]), - {error, genErr, Index}; -validate_tab_res(_TooMany, [], Mfa, _Res, I) -> - user_err("Too many values returned from ~w (get)", [Mfa]), - {error, genErr, I}. %%%----------------------------------------------------------------- @@ -3125,491 +2815,12 @@ validate_tab_res(_TooMany, [], Mfa, _Res, I) -> %% subagent must be considered to be very rare. %%----------------------------------------------------------------- -%% It may be a bit agressive to check this already, -%% but since it is a security measure, it makes sense. -do_get_next(_MibView, UnsortedVarbinds, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso (length(UnsortedVarbinds) > GbMaxVBs)) -> - {tooBig, 0, []}; % What is the correct index in this case? -do_get_next(MibView, UnsortedVBs, GbMaxVBs) -> - ?vt("do_get_next -> entry when" - "~n MibView: ~p" - "~n UnsortedVBs: ~p", [MibView, UnsortedVBs]), - SortedVBs = oid_sort_vbs(UnsortedVBs), - ?vt("do_get_next -> " - "~n SortedVBs: ~p", [SortedVBs]), - next_loop_varbinds([], SortedVBs, MibView, [], [], GbMaxVBs). - -oid_sort_vbs(Vbs) -> - lists:keysort(#varbind.oid, Vbs). - -next_loop_varbinds(_, Vbs, _MibView, Res, _LAVb, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso - ((length(Vbs) + length(Res)) > GbMaxVBs)) -> - {tooBig, 0, []}; % What is the correct index in this case? - -%% LAVb is Last Accessible Vb -next_loop_varbinds([], [Vb | Vbs], MibView, Res, LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds -> entry when" - "~n Vb: ~p" - "~n MibView: ~p", [Vb, MibView]), - case varbind_next(Vb, MibView) of - endOfMibView -> - ?vt("next_loop_varbind -> endOfMibView", []), - RVb = if LAVb =:= [] -> Vb; - true -> LAVb - end, - NewVb = RVb#varbind{variabletype = 'NULL', value = endOfMibView}, - next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], GbMaxVBs); - - {variable, ME, VarOid} when ((ME#me.access =/= 'not-accessible') andalso - (ME#me.access =/= 'write-only') andalso - (ME#me.access =/= 'accessible-for-notify')) -> - ?vt("next_loop_varbind -> variable: " - "~n ME: ~p" - "~n VarOid: ~p", [ME, VarOid]), - case try_get_instance(Vb, ME) of - {value, noValue, _NoSuchSomething} -> - ?vt("next_loop_varbind -> noValue", []), - %% Try next one - NewVb = Vb#varbind{oid = VarOid, - value = 'NULL'}, - next_loop_varbinds([], [NewVb | Vbs], MibView, Res, [], - GbMaxVBs); - {value, Type, Value} -> - ?vt("next_loop_varbind -> value" - "~n Type: ~p" - "~n Value: ~p", [Type, Value]), - NewVb = Vb#varbind{oid = VarOid, - variabletype = Type, - value = Value}, - next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], - GbMaxVBs); - {error, ErrorStatus} -> - ?vdebug("next loop varbinds:" - "~n ErrorStatus: ~p",[ErrorStatus]), - {ErrorStatus, Vb#varbind.org_index, []} - end; - {variable, _ME, VarOid} -> - ?vt("next_loop_varbind -> variable: " - "~n VarOid: ~p", [VarOid]), - RVb = if LAVb =:= [] -> Vb; - true -> LAVb - end, - NewVb = Vb#varbind{oid = VarOid, value = 'NULL'}, - next_loop_varbinds([], [NewVb | Vbs], MibView, Res, RVb, GbMaxVBs); - {table, TableOid, TableRestOid, ME} -> - ?vt("next_loop_varbind -> table: " - "~n TableOid: ~p" - "~n TableRestOid: ~p" - "~n ME: ~p", [TableOid, TableRestOid, ME]), - next_loop_varbinds({table, TableOid, ME, - [{tab_oid(TableRestOid), Vb}]}, - Vbs, MibView, Res, [], GbMaxVBs); - {subagent, SubAgentPid, SAOid} -> - ?vt("next_loop_varbind -> subagent: " - "~n SubAgentPid: ~p" - "~n SAOid: ~p", [SubAgentPid, SAOid]), - NewVb = Vb#varbind{variabletype = 'NULL', value = 'NULL'}, - next_loop_varbinds({subagent, SubAgentPid, SAOid, [NewVb]}, - Vbs, MibView, Res, [], GbMaxVBs) - end; -next_loop_varbinds({table, TableOid, ME, TabOids}, - [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(table) -> entry with" - "~n TableOid: ~p" - "~n Vb: ~p", [TableOid, Vb]), - case varbind_next(Vb, MibView) of - {table, TableOid, TableRestOid, _ME} -> - next_loop_varbinds({table, TableOid, ME, - [{tab_oid(TableRestOid), Vb} | TabOids]}, - Vbs, MibView, Res, [], GbMaxVBs); - _ -> - case get_next_table(ME, TableOid, TabOids, MibView) of - {ok, TabRes, TabEndOfTabVbs} -> - NewVbs = lists:append(TabEndOfTabVbs, [Vb | Vbs]), - NewRes = lists:append(TabRes, Res), - next_loop_varbinds([], NewVbs, MibView, NewRes, [], - GbMaxVBs); - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next varbind" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end - end; -next_loop_varbinds({table, TableOid, ME, TabOids}, - [], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(table) -> entry with" - "~n TableOid: ~p", [TableOid]), - case get_next_table(ME, TableOid, TabOids, MibView) of - {ok, TabRes, TabEndOfTabVbs} -> - ?vt("next_loop_varbinds(table) -> get_next_table result:" - "~n TabRes: ~p" - "~n TabEndOfTabVbs: ~p", [TabRes, TabEndOfTabVbs]), - NewRes = lists:append(TabRes, Res), - next_loop_varbinds([], TabEndOfTabVbs, MibView, NewRes, [], - GbMaxVBs); - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next table" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end; -next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, - [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(subagent) -> entry with" - "~n SAPid: ~p" - "~n SAOid: ~p" - "~n Vb: ~p", [SAPid, SAOid, Vb]), - case varbind_next(Vb, MibView) of - {subagent, _SubAgentPid, SAOid} -> - next_loop_varbinds({subagent, SAPid, SAOid, - [Vb | SAVbs]}, - Vbs, MibView, Res, [], GbMaxVBs); - _ -> - case get_next_sa(SAPid, SAOid, SAVbs, MibView) of - {ok, SARes, SAEndOfMibViewVbs} -> - NewVbs = lists:append(SAEndOfMibViewVbs, [Vb | Vbs]), - NewRes = lists:append(SARes, Res), - next_loop_varbinds([], NewVbs, MibView, NewRes, [], - GbMaxVBs); - {noSuchName, OrgIndex} -> - %% v1 reply, treat this Vb as endOfMibView, and try again - %% for the others. - case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of - {value, EVb} -> - NextOid = next_oid(SAOid), - EndOfVb = - EVb#varbind{oid = NextOid, - value = {endOfMibView, NextOid}}, - case lists:delete(EVb, SAVbs) of - [] -> - next_loop_varbinds([], [EndOfVb, Vb | Vbs], - MibView, Res, [], - GbMaxVBs); - TryAgainVbs -> - next_loop_varbinds({subagent, SAPid, SAOid, - TryAgainVbs}, - [EndOfVb, Vb | Vbs], - MibView, Res, [], - GbMaxVBs) - end; - false -> - %% bad index from subagent - {genErr, (hd(SAVbs))#varbind.org_index, []} - end; - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next subagent" - "~n Vb: ~p" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [Vb,ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end - end; -next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, - [], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(subagent) -> entry with" - "~n SAPid: ~p" - "~n SAOid: ~p", [SAPid, SAOid]), - case get_next_sa(SAPid, SAOid, SAVbs, MibView) of - {ok, SARes, SAEndOfMibViewVbs} -> - NewRes = lists:append(SARes, Res), - next_loop_varbinds([], SAEndOfMibViewVbs, MibView, NewRes, [], - GbMaxVBs); - {noSuchName, OrgIndex} -> - %% v1 reply, treat this Vb as endOfMibView, and try again for - %% the others. - case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of - {value, EVb} -> - NextOid = next_oid(SAOid), - EndOfVb = EVb#varbind{oid = NextOid, - value = {endOfMibView, NextOid}}, - case lists:delete(EVb, SAVbs) of - [] -> - next_loop_varbinds([], [EndOfVb], MibView, Res, [], - GbMaxVBs); - TryAgainVbs -> - next_loop_varbinds({subagent, SAPid, SAOid, - TryAgainVbs}, - [EndOfVb], MibView, Res, [], - GbMaxVBs) - end; - false -> - %% bad index from subagent - {genErr, (hd(SAVbs))#varbind.org_index, []} - end; - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next subagent" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end; -next_loop_varbinds([], [], _MibView, Res, _LAVb, _GbMaxVBs) -> - ?vt("next_loop_varbinds -> entry when done", []), - {noError, 0, Res}. - -try_get_instance(_Vb, #me{mfa = {M, F, A}, asn1_type = ASN1Type}) -> - ?vtrace("try_get_instance -> entry with" - "~n M: ~p" - "~n F: ~p" - "~n A: ~p", [M,F,A]), - Result = (catch dbg_apply(M, F, [get | A])), - % mib shall return {value, <a-nice-value-within-range>} | - % {noValue, noSuchName} (v1) | - % {noValue, noSuchObject | noSuchInstance} (v2, v1) - % everything else (including 'genErr') will generate 'genErr'. - make_value_a_correct_value(Result, ASN1Type, {M, F, A}). - -tab_oid([]) -> [0]; -tab_oid(X) -> X. - -%%----------------------------------------------------------------- -%% Perform a next, using the varbinds Oid if value is simple -%% value. If value is {endOf<something>, NextOid}, use NextOid. -%% This case happens when a table has returned endOfTable, or -%% a subagent has returned endOfMibView. -%%----------------------------------------------------------------- -varbind_next(#varbind{value = Value, oid = Oid}, MibView) -> - ?vt("varbind_next -> entry with" - "~n Value: ~p" - "~n Oid: ~p" - "~n MibView: ~p", [Value, Oid, MibView]), - case Value of - {endOfTable, NextOid} -> - snmpa_mib:next(get(mibserver), NextOid, MibView); - {endOfMibView, NextOid} -> - snmpa_mib:next(get(mibserver), NextOid, MibView); - _ -> - snmpa_mib:next(get(mibserver), Oid, MibView) - end. +do_get_next(MibView, UnsortedVarbinds) -> + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get_next(MibView, UnsortedVarbinds, Extra). -get_next_table(#me{mfa = {M, F, A}}, TableOid, TableOids, MibView) -> - % We know that all TableOids have at least a column number as oid - ?vt("get_next_table -> entry with" - "~n M: ~p" - "~n F: ~p" - "~n A: ~p" - "~n TableOid: ~p" - "~n TableOids: ~p" - "~n MibView: ~p", [M, F, A, TableOid, TableOids, MibView]), - Sorted = snmpa_svbl:sort_varbinds_rows(TableOids), - case get_next_values_all_rows(Sorted, M,F,A, [], TableOid) of - NewVbs when is_list(NewVbs) -> - ?vt("get_next_table -> " - "~n NewVbs: ~p", [NewVbs]), - % We must now check each Vb for endOfTable and that it is - % in the MibView. If not, it becomes a endOfTable. We - % collect all of these together. - transform_tab_next_result(NewVbs, {[], []}, MibView); - {ErrorStatus, OrgIndex} -> - {ErrorStatus, OrgIndex} - end. - -get_next_values_all_rows([Row | Rows], M, F, A, Res, TabOid) -> - {RowIndex, TableOids} = Row, - Cols = delete_index(TableOids), - ?vt("get_next_values_all_rows -> " - "~n Cols: ~p", [Cols]), - Result = (catch dbg_apply(M, F, [get_next, RowIndex, Cols | A])), - ?vt("get_next_values_all_rows -> " - "~n Result: ~p", [Result]), - case validate_tab_next_res(Result, TableOids, {M, F, A}, TabOid) of - Values when is_list(Values) -> - ?vt("get_next_values_all_rows -> " - "~n Values: ~p", [Values]), - NewRes = lists:append(Values, Res), - get_next_values_all_rows(Rows, M, F, A, NewRes, TabOid); - {ErrorStatus, OrgIndex} -> - {ErrorStatus, OrgIndex} - end; -get_next_values_all_rows([], _M, _F, _A, Res, _TabOid) -> - Res. - -transform_tab_next_result([Vb | Vbs], {Res, EndOfs}, MibView) -> - case Vb#varbind.value of - {endOfTable, _} -> -%% ?vtrace("transform_tab_next_result -> endOfTable: " -%% "split varbinds",[]), -%% R = split_varbinds(Vbs, Res, [Vb | EndOfs]), -%% ?vtrace("transform_tab_next_result -> " -%% "~n R: ~p", [R]), -%% R; - split_varbinds(Vbs, Res, [Vb | EndOfs]); - _ -> - case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of - true -> - transform_tab_next_result(Vbs, {[Vb|Res], EndOfs},MibView); - _ -> - Oid = Vb#varbind.oid, - NewEndOf = Vb#varbind{value = {endOfTable, Oid}}, - transform_tab_next_result(Vbs, {Res, [NewEndOf | EndOfs]}, - MibView) - end - end; -transform_tab_next_result([], {Res, EndOfs}, _MibView) -> - ?vt("transform_tab_next_result -> entry with: " - "~n Res: ~p" - "~n EndIfs: ~p",[Res, EndOfs]), - {ok, Res, EndOfs}. - -%%----------------------------------------------------------------- -%% Three cases: -%% 1) All values ok -%% 2) table_func returned {Error, ...} -%% 3) Some value in Values list is erroneous. -%% Args: Value is a list of values from table_func(get_next, ...) -%% TableOids is a list of {TabRestOid, OrgVb} -%% each element in Values and TableOids correspond to each -%% other. -%% Returns: List of NewVarbinds | -%% {ErrorStatus, OrgIndex} -%% (In the NewVarbinds list, the value may be endOfTable) -%%----------------------------------------------------------------- -validate_tab_next_res(Values, TableOids, Mfa, TabOid) -> - ?vt("validate_tab_next_res -> entry with: " - "~n Values: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n TabOid: ~p", [Values, TableOids, Mfa, TabOid]), - {_Col, _ASN1Type, OneIdx} = hd(TableOids), - validate_tab_next_res(Values, TableOids, Mfa, [], TabOid, - next_oid(TabOid), OneIdx). -validate_tab_next_res([{NextOid, Value} | Values], - [{_ColNo, OrgVb, _Index} | TableOids], - Mfa, Res, TabOid, TabNextOid, I) -> - ?vt("validate_tab_next_res -> entry with: " - "~n NextOid: ~p" - "~n Value: ~p" - "~n Values: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n TabOid: ~p", - [NextOid, Value, Values, TableOids, Mfa, TabOid]), - #varbind{org_index = OrgIndex} = OrgVb, - ?vt("validate_tab_next_res -> OrgIndex: ~p", [OrgIndex]), - NextCompleteOid = lists:append(TabOid, NextOid), - case snmpa_mib:lookup(get(mibserver), NextCompleteOid) of - {table_column, #me{asn1_type = ASN1Type}, _TableEntryOid} -> - ?vt("validate_tab_next_res -> ASN1Type: ~p", [ASN1Type]), - case make_value_a_correct_value({value, Value}, ASN1Type, Mfa) of - {error, ErrorStatus} -> - ?vt("validate_tab_next_res -> " - "~n ErrorStatus: ~p", [ErrorStatus]), - {ErrorStatus, OrgIndex}; - {value, Type, NValue} -> - ?vt("validate_tab_next_res -> " - "~n Type: ~p" - "~n NValue: ~p", [Type, NValue]), - NewVb = OrgVb#varbind{oid = NextCompleteOid, - variabletype = Type, value = NValue}, - validate_tab_next_res(Values, TableOids, Mfa, - [NewVb | Res], TabOid, TabNextOid, I) - end; - Error -> - user_err("Invalid oid ~w from ~w (get_next). Using genErr => ~p", - [NextOid, Mfa, Error]), - {genErr, OrgIndex} - end; -validate_tab_next_res([endOfTable | Values], - [{_ColNo, OrgVb, _Index} | TableOids], - Mfa, Res, TabOid, TabNextOid, I) -> - ?vt("validate_tab_next_res(endOfTable) -> entry with: " - "~n Values: ~p" - "~n OrgVb: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n Res: ~p" - "~n TabOid: ~p" - "~n TabNextOid: ~p" - "~n I: ~p", - [Values, OrgVb, TableOids, Mfa, Res, TabOid, TabNextOid, I]), - NewVb = OrgVb#varbind{value = {endOfTable, TabNextOid}}, - validate_tab_next_res(Values, TableOids, Mfa, [NewVb | Res], - TabOid, TabNextOid, I); -validate_tab_next_res([], [], _Mfa, Res, _TabOid, _TabNextOid, _I) -> - Res; -validate_tab_next_res([], [{_Col, _OrgVb, Index}|_], Mfa, _Res, _, _, _I) -> - user_err("Too few values returned from ~w (get_next)", [Mfa]), - {genErr, Index}; -validate_tab_next_res({genErr, ColNumber}, OrgCols, - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - OrgIndex = snmpa_svbl:col_to_orgindex(ColNumber, OrgCols), - validate_err(table_next, {genErr, OrgIndex}, Mfa); -validate_tab_next_res({error, Reason}, [{_ColNo, OrgVb, _Index} | _TableOids], - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - #varbind{org_index = OrgIndex} = OrgVb, - user_err("Erroneous return value ~w from ~w (get_next)", - [Reason, Mfa]), - {genErr, OrgIndex}; -validate_tab_next_res(Error, [{_ColNo, OrgVb, _Index} | _TableOids], - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - #varbind{org_index = OrgIndex} = OrgVb, - user_err("Invalid return value ~w from ~w (get_next)", - [Error, Mfa]), - {genErr, OrgIndex}; -validate_tab_next_res(TooMany, [], Mfa, _Res, _, _, I) -> - user_err("Too many values ~w returned from ~w (get_next)", - [TooMany, Mfa]), - {genErr, I}. - -%%----------------------------------------------------------------- -%% Func: get_next_sa/4 -%% Purpose: Loop the list of varbinds for the subagent. -%% Call subagent_get_next to retreive -%% the next varbinds. -%% Returns: {ok, ListOfNewVbs, ListOfEndOfMibViewsVbs} | -%% {ErrorStatus, ErrorIndex} -%%----------------------------------------------------------------- -get_next_sa(SAPid, SAOid, SAVbs, MibView) -> - case catch subagent_get_next(SAPid, MibView, SAVbs) of - {noError, 0, NewVbs} -> - NewerVbs = transform_sa_next_result(NewVbs,SAOid,next_oid(SAOid)), - split_varbinds(NewerVbs, [], []); - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex}; - {'EXIT', Reason} -> - user_err("Lost contact with subagent (next) ~w. Using genErr", - [Reason]), - {genErr, 0} - end. - -%%----------------------------------------------------------------- -%% Check for wrong prefix returned or endOfMibView, and convert -%% into {endOfMibView, SANextOid}. -%%----------------------------------------------------------------- -transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) - when Vb#varbind.value =:= endOfMibView -> - [Vb#varbind{value = {endOfMibView, SANextOid}} | - transform_sa_next_result(Vbs, SAOid, SANextOid)]; -transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) -> - case lists:prefix(SAOid, Vb#varbind.oid) of - true -> - [Vb | transform_sa_next_result(Vbs, SAOid, SANextOid)]; - _ -> - [Vb#varbind{oid = SANextOid, value = {endOfMibView, SANextOid}} | - transform_sa_next_result(Vbs, SAOid, SANextOid)] - end; -transform_sa_next_result([], _SAOid, _SANextOid) -> - []. - -split_varbinds([Vb | Vbs], Res, EndOfs) -> - case Vb#varbind.value of - {endOfMibView, _} -> split_varbinds(Vbs, Res, [Vb | EndOfs]); - {endOfTable, _} -> split_varbinds(Vbs, Res, [Vb | EndOfs]); - _ -> split_varbinds(Vbs, [Vb | Res], EndOfs) - end; -split_varbinds([], Res, EndOfs) -> {ok, Res, EndOfs}. - -next_oid(Oid) -> - case lists:reverse(Oid) of - [H | T] -> lists:reverse([H+1 | T]); - [] -> [] - end. %%%----------------------------------------------------------------- @@ -3623,200 +2834,12 @@ next_oid(Oid) -> %%%----------------------------------------------------------------- do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs) -> - ?vtrace("do_get_bulk -> entry with" - "~n MibView: ~p" - "~n NonRepeaters: ~p" - "~n MaxRepetitions: ~p" - "~n PduMS: ~p" - "~n Varbinds: ~p" - "~n GbMaxVBs: ~p", - [MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs]), - {NonRepVbs, RestVbs} = split_vbs(NonRepeaters, Varbinds, []), - ?vt("do_get_bulk -> split: " - "~n NonRepVbs: ~p" - "~n RestVbs: ~p", [NonRepVbs, RestVbs]), - case do_get_next(MibView, NonRepVbs, GbMaxVBs) of - {noError, 0, UResNonRepVbs} -> - ?vt("do_get_bulk -> next noError: " - "~n UResNonRepVbs: ~p", [UResNonRepVbs]), - ResNonRepVbs = lists:keysort(#varbind.org_index, UResNonRepVbs), - %% Decode the first varbinds, produce a reversed list of - %% listOfBytes. - case (catch enc_vbs(PduMS - ?empty_pdu_size, ResNonRepVbs)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), - {genErr, Idx, []}; - {SizeLeft, Res} when is_integer(SizeLeft) and is_list(Res) -> - ?vtrace("do_get_bulk -> encoded: " - "~n SizeLeft: ~p" - "~n Res: ~w", [SizeLeft, Res]), - case (catch do_get_rep(SizeLeft, MibView, MaxRepetitions, - RestVbs, Res, - length(UResNonRepVbs), GbMaxVBs)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", - [Idx, Reason]), - {genErr, Idx, []}; - Res when is_list(Res) -> - ?vtrace("do get bulk -> Res: " - "~n ~w", [Res]), - {noError, 0, conv_res(Res)}; - {noError, 0, Data} = OK -> - ?vtrace("do get bulk -> OK: " - "~n length(Data): ~w", [length(Data)]), - OK; - Else -> - ?vtrace("do get bulk -> Else: " - "~n ~w", [Else]), - Else - end; - Res when is_list(Res) -> - {noError, 0, conv_res(Res)} - end; + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, + Extra). - {ErrorStatus, Index, _} -> - ?vdebug("do get bulk: " - "~n ErrorStatus: ~p" - "~n Index: ~p",[ErrorStatus, Index]), - {ErrorStatus, Index, []} - end. - -% sz(L) when list(L) -> length(L); -% sz(B) when binary(B) -> size(B); -% sz(_) -> unknown. - -split_vbs(N, Varbinds, Res) when N =< 0 -> {Res, Varbinds}; -split_vbs(N, [H | T], Res) -> split_vbs(N-1, T, [H | Res]); -split_vbs(_N, [], Res) -> {Res, []}. - -enc_vbs(SizeLeft, Vbs) -> - ?vt("enc_vbs -> entry with" - "~n SizeLeft: ~w", [SizeLeft]), - Fun = fun(Vb, {Sz, Res}) when Sz > 0 -> - ?vt("enc_vbs -> (fun) entry with" - "~n Vb: ~p" - "~n Sz: ~p" - "~n Res: ~w", [Vb, Sz, Res]), - case (catch snmp_pdus:enc_varbind(Vb)) of - {'EXIT', Reason} -> - ?vtrace("enc_vbs -> encode failed: " - "~n Reason: ~p", [Reason]), - throw({error, Vb#varbind.org_index, Reason}); - X -> - ?vt("enc_vbs -> X: ~w", [X]), - Lx = length(X), - ?vt("enc_vbs -> Lx: ~w", [Lx]), - if - Lx < Sz -> - {Sz - length(X), [X | Res]}; - true -> - throw(Res) - end - end; - (_Vb, {_Sz, [_H | T]}) -> - ?vt("enc_vbs -> (fun) entry with" - "~n T: ~p", [T]), - throw(T); - (_Vb, {_Sz, []}) -> - ?vt("enc_vbs -> (fun) entry", []), - throw([]) - end, - lists:foldl(Fun, {SizeLeft, []}, Vbs). - -do_get_rep(Sz, MibView, MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) - when MaxRepetitions >= 0 -> - do_get_rep(Sz, MibView, 0, MaxRepetitions, Varbinds, Res, - GbNumVBs, GbMaxVBs); -do_get_rep(Sz, MibView, _MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) -> - do_get_rep(Sz, MibView, 0, 0, Varbinds, Res, GbNumVBs, GbMaxVBs). - -conv_res(ResVarbinds) -> - conv_res(ResVarbinds, []). -conv_res([VbListOfBytes | T], Bytes) -> - conv_res(T, VbListOfBytes ++ Bytes); -conv_res([], Bytes) -> - Bytes. - -%% The only other value, then a positive integer, is infinity. -do_get_rep(_Sz, _MibView, Count, Max, _, _Res, GbNumVBs, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso (GbNumVBs > GbMaxVBs)) -> - ?vinfo("Max Get-BULK VBs limit (~w) exceeded (~w) when:" - "~n Count: ~p" - "~n Max: ~p", [GbMaxVBs, GbNumVBs, Count, Max]), - {tooBig, 0, []}; -do_get_rep(_Sz, _MibView, Max, Max, _, Res, _GbNumVBs, _GbMaxVBs) -> - ?vt("do_get_rep -> done when: " - "~n Res: ~p", [Res]), - {noError, 0, conv_res(Res)}; -do_get_rep(Sz, MibView, Count, Max, Varbinds, Res, GbNumVBs, GbMaxVBs) -> - ?vt("do_get_rep -> entry when: " - "~n Sz: ~p" - "~n Count: ~p" - "~n Res: ~w", [Sz, Count, Res]), - case try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) of - {noError, NextVarbinds, SizeLeft, Res2} -> - ?vt("do_get_rep -> noError: " - "~n SizeLeft: ~p" - "~n Res2: ~p", [SizeLeft, Res2]), - do_get_rep(SizeLeft, MibView, Count+1, Max, NextVarbinds, - Res2 ++ Res, - GbNumVBs + length(Varbinds), GbMaxVBs); - {endOfMibView, _NextVarbinds, _SizeLeft, Res2} -> - ?vt("do_get_rep -> endOfMibView: " - "~n Res2: ~p", [Res2]), - {noError, 0, conv_res(Res2 ++ Res)}; - {ErrorStatus, Index} -> - ?vtrace("do_get_rep -> done when error: " - "~n ErrorStatus: ~p" - "~n Index: ~p", [ErrorStatus, Index]), - {ErrorStatus, Index, []} - end. - -org_index_sort_vbs(Vbs) -> - lists:keysort(#varbind.org_index, Vbs). - -try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) -> - ?vt("try_get_bulk -> entry with" - "~n Sz: ~w" - "~n MibView: ~w" - "~n Varbinds: ~w", [Sz, MibView, Varbinds]), - case do_get_next(MibView, Varbinds, GbMaxVBs) of - {noError, 0, UNextVarbinds} -> - ?vt("try_get_bulk -> noError: " - "~n UNextVarbinds: ~p", [UNextVarbinds]), - NextVarbinds = org_index_sort_vbs(UNextVarbinds), - case (catch enc_vbs(Sz, NextVarbinds)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), - ?vtrace("try_get_bulk -> encode error: " - "~n Idx: ~p" - "~n Reason: ~p", [Idx, Reason]), - {genErr, Idx}; - {SizeLeft, Res} when is_integer(SizeLeft) andalso - is_list(Res) -> - ?vt("try get bulk -> encode ok: " - "~n SizeLeft: ~w" - "~n Res: ~w", [SizeLeft, Res]), - {check_end_of_mibview(NextVarbinds), - NextVarbinds, SizeLeft, Res}; - Res when is_list(Res) -> - ?vt("try get bulk -> Res: " - "~n ~w", [Res]), - {endOfMibView, [], 0, Res} - end; - {ErrorStatus, Index, _} -> - ?vt("try_get_bulk -> error: " - "~n ErrorStatus: ~p" - "~n Index: ~p", [ErrorStatus, Index]), - {ErrorStatus, Index} - end. - -%% If all variables in this pass are endOfMibView, -%% there is no reason to continue. -check_end_of_mibview([#varbind{value = endOfMibView} | T]) -> - check_end_of_mibview(T); -check_end_of_mibview([]) -> endOfMibView; -check_end_of_mibview(_) -> noError. %%%-------------------------------------------------- @@ -3834,14 +2857,11 @@ do_subagent_set(Arguments) -> SetModule = get(set_module), apply(SetModule, do_subagent_set, [Arguments]). + + %%%----------------------------------------------------------------- %%% 7. Misc functions %%%----------------------------------------------------------------- -sort_varbindlist(Varbinds) -> - snmpa_svbl:sort_varbindlist(get(mibserver), Varbinds). - -sa_split(SubagentVarbinds) -> - snmpa_svbl:sa_split(SubagentVarbinds). make_response_pdu(ReqId, ErrStatus, ErrIndex, OrgVarbinds, _ResponseVarbinds) when ErrIndex =/= 0 -> @@ -4139,6 +3159,7 @@ report_err(Val, Mfa, Err) -> user_err("Got ~p from ~w. Using ~w", [Val, Mfa, Err]), {error, Err}. + is_valid_pdu_type('get-request') -> true; is_valid_pdu_type('get-next-request') -> true; is_valid_pdu_type('get-bulk-request') -> true; @@ -4176,33 +3197,8 @@ mapfoldl(F, Eas, Accu0, [Hd|Tail]) -> mapfoldl(_F, _Eas, Accu, []) -> {Accu,[]}. -%%----------------------------------------------------------------- -%% Runtime debugging of the agent. -%%----------------------------------------------------------------- - -dbg_apply(M,F,A) -> - case get(verbosity) of - silence -> - apply(M,F,A); - _ -> - ?vlog("~n apply: ~w,~w,~p~n", [M,F,A]), - Res = (catch apply(M,F,A)), - case Res of - {'EXIT', Reason} -> - ?vinfo("Call to: " - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p" - "~n" - "~nresulted in an exit" - "~n" - "~n ~p", [M, F, A, Reason]); - _ -> - ?vlog("~n returned: ~p", [Res]) - end, - Res - end. +%% --------------------------------------------------------------------- short_name(none) -> ma; short_name(_Pid) -> sa. @@ -4450,6 +3446,9 @@ get_mib_storage(Opts) -> get_set_mechanism(Opts) -> get_option(set_mechanism, Opts, snmpa_set). +get_get_mechanism(Opts) -> + get_option(get_mechanism, Opts, snmpa_get). + get_authentication_service(Opts) -> get_option(authentication_service, Opts, snmpa_acm). diff --git a/lib/snmp/src/agent/snmpa_app.erl b/lib/snmp/src/agent/snmpa_app.erl index 86ff145e93..c00929c334 100644 --- a/lib/snmp/src/agent/snmpa_app.erl +++ b/lib/snmp/src/agent/snmpa_app.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. @@ -67,6 +67,7 @@ convert_config(Opts) -> SaVerb = get_sub_agent_verbosity(Opts), [{agent_type, AgentType}, {agent_verbosity, SaVerb}, + {get_mechanism, snmpa_get}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {priority, Prio}, @@ -97,6 +98,7 @@ convert_config(Opts) -> {verbosity, ConfVerb}], [{agent_type, AgentType}, {agent_verbosity, MaVerb}, + {get_mechanism, snmpa_get}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {db_dir, DbDir}, diff --git a/lib/snmp/src/agent/snmpa_get.erl b/lib/snmp/src/agent/snmpa_get.erl new file mode 100644 index 0000000000..e67975a67d --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get.erl @@ -0,0 +1,1150 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-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. +%% 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(snmpa_get). + +-behaviour(snmpa_get_mechanism). + + +%%%----------------------------------------------------------------- +%%% snmpa_get_mechanism exports +%%%----------------------------------------------------------------- + +-export([ + do_get/3, do_get/4, + do_get_next/3, + do_get_bulk/7 + ]). + +-define(VMODULE,"GET"). +-include("snmpa_internal.hrl"). +-include("snmp_types.hrl"). +-include("snmp_debug.hrl"). +-include("snmp_verbosity.hrl"). + +-ifndef(default_verbosity). +-define(default_verbosity,silence). +-endif. + +-define(empty_pdu_size, 21). + +-ifdef(snmp_extended_verbosity). +-define(vt(F,A), ?vtrace(F, A)). +-else. +-define(vt(_F, _A), ok). +-endif. + + +-define(AGENT, snmpa_agent). +-define(LIB, snmpa_get_lib). + + + +%%%----------------------------------------------------------------- +%%% 3. GET REQUEST +%%% -------------- +%%% According to RFC1157, section 4.1.2 and RFC1905, section 4.2.1. +%%% In rfc1157:4.1.2 it isn't specified if noSuchName should be +%%% returned even if some other varbind generates a genErr. +%%% In rfc1905:4.2.1 this is not a problem since exceptions are +%%% used, and thus a genErr will be returned anyway. +%%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: do_get/2 +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(UnsortedVarbinds, IsNotification, _Extra) -> + {MyVarbinds, SubagentVarbinds} = ?LIB:agent_sort_vbs(UnsortedVarbinds), + case do_get_local(MyVarbinds, IsNotification) of + {noError, 0, NewMyVarbinds} -> + case do_get_subagents(SubagentVarbinds, IsNotification) of + {noError, 0, NewSubagentVarbinds} -> + {noError, 0, NewMyVarbinds ++ NewSubagentVarbinds}; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []} + end; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []} + end. + + +%%----------------------------------------------------------------- +%% Func: do_get/3 +%% Purpose: do_get handles "getRequests". +%% Pre: incoming varbinds have type == 'NULL', value == unSpecified +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(MibView, UnsortedVarbinds, IsNotification, Extra) -> + ?vtrace("do_get -> entry with" + "~n MibView: ~p" + "~n UnsortedVarbinds: ~p" + "~n IsNotification: ~p", + [MibView, UnsortedVarbinds, IsNotification]), + %% This is me, the master, so go ahead + {OutSideView, InSideView} = ?LIB:split_vbs_view(UnsortedVarbinds, MibView), + {Error, Index, NewVbs} = do_get(InSideView, IsNotification, Extra), + {Error, Index, NewVbs ++ OutSideView}. + + + +%%----------------------------------------------------------------- +%% Func: do_get_local/2,3 +%% Purpose: Loop the variablebindings list. We know that each varbind +%% in that list belongs to us. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get_local(VBs, IsNotification) -> + do_get_local(VBs, [], IsNotification). + +do_get_local([Vb | Vbs], Res, IsNotification) -> + case try_get(Vb, IsNotification) of + NewVb when is_record(NewVb, varbind) -> + do_get_local(Vbs, [NewVb | Res], IsNotification); + ListOfNewVb when is_list(ListOfNewVb) -> + do_get_local(Vbs, lists:append(ListOfNewVb, Res), IsNotification); + {error, Error, OrgIndex} -> + {Error, OrgIndex, []} + end; +do_get_local([], Res, _IsNotification) -> + {noError, 0, Res}. + + + +%%----------------------------------------------------------------- +%% Func: do_get_subagents/2 +%% Purpose: Loop the list of varbinds for different subagents. +%% For each of them, call sub_agent_get to retreive +%% the values for them. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- +do_get_subagents(SubagentVarbinds, IsNotification) -> + do_get_subagents(SubagentVarbinds, [], IsNotification). +do_get_subagents([{SubAgentPid, SAVbs} | Tail], Res, IsNotification) -> + {_SAOids, Vbs} = ?LIB:sa_split(SAVbs), + case catch ?AGENT:subagent_get(SubAgentPid, Vbs, IsNotification) of + {noError, 0, NewVbs} -> + do_get_subagents(Tail, lists:append(NewVbs, Res), IsNotification); + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []}; + {'EXIT', Reason} -> + ?LIB:user_err("Lost contact with subagent (get) ~w. Using genErr", + [Reason]), + {genErr, 0, []} + end; +do_get_subagents([], Res, _IsNotification) -> + {noError, 0, Res}. + + +%%----------------------------------------------------------------- +%% Func: try_get/2 +%% Returns: {error, ErrorStatus, OrgIndex} | +%% #varbind | +%% List of #varbind +%%----------------------------------------------------------------- +try_get(IVb, IsNotification) when is_record(IVb, ivarbind) -> + ?vtrace("try_get(ivarbind) -> entry with" + "~n IVb: ~p", [IVb]), + get_var_value_from_ivb(IVb, IsNotification); +try_get({TableOid, TableVbs}, IsNotification) -> + ?vtrace("try_get(table) -> entry with" + "~n TableOid: ~p" + "~n TableVbs: ~p", [TableOid, TableVbs]), + [#ivarbind{mibentry = MibEntry}|_] = TableVbs, + {NoAccessVbs, AccessVbs} = + check_all_table_vbs(TableVbs, IsNotification, [], []), + case get_tab_value_from_mib(MibEntry, TableOid, AccessVbs) of + {error, ErrorStatus, OrgIndex} -> + {error, ErrorStatus, OrgIndex}; + NVbs -> + NVbs ++ NoAccessVbs + end. + +%%----------------------------------------------------------------- +%% Make sure all requested columns are accessible. +%%----------------------------------------------------------------- +check_all_table_vbs([IVb| IVbs], IsNotification, NoA, A) -> + #ivarbind{mibentry = Me, varbind = Vb} = IVb, + case Me#me.access of + 'not-accessible' -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + 'accessible-for-notify' when IsNotification =:= false -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + 'write-only' -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + _ -> + check_all_table_vbs(IVbs, IsNotification, NoA, [IVb | A]) + end; +check_all_table_vbs([], _IsNotification, NoA, A) -> {NoA, A}. + +%%----------------------------------------------------------------- +%% Returns: {error, ErrorStatus, OrgIndex} | +%% #varbind +%%----------------------------------------------------------------- +get_var_value_from_ivb(IVb, IsNotification) + when IVb#ivarbind.status =:= noError -> + ?vtrace("get_var_value_from_ivb(noError) -> entry", []), + #ivarbind{mibentry = Me, varbind = Vb} = IVb, + #varbind{org_index = OrgIndex, oid = Oid} = Vb, + case Me#me.access of + 'not-accessible' -> + Vb#varbind{value = noSuchInstance}; + 'accessible-for-notify' when IsNotification =:= false -> + Vb#varbind{value = noSuchInstance}; + 'write-only' -> + Vb#varbind{value = noSuchInstance}; + _ -> + case get_var_value_from_mib(Me, Oid) of + {value, Type, Value} -> + Vb#varbind{variabletype = Type, value = Value}; + {error, ErrorStatus} -> + {error, ErrorStatus, OrgIndex} + end + end; +get_var_value_from_ivb(#ivarbind{status = Status, varbind = Vb}, _) -> + ?vtrace("get_var_value_from_ivb(~p) -> entry", [Status]), + Vb#varbind{value = Status}. + +%%----------------------------------------------------------------- +%% Func: get_var_value_from_mib/1 +%% Purpose: +%% Returns: {error, ErrorStatus} | +%% {value, Type, Value} +%%----------------------------------------------------------------- +%% Pre: Oid is a correct instance Oid (lookup checked that). +%% Returns: A correct return value (see ?AGENT:make_value_a_correct_value) +get_var_value_from_mib(#me{entrytype = variable, + asn1_type = ASN1Type, + mfa = {Mod, Func, Args}}, + _Oid) -> + ?vtrace("get_var_value_from_mib(variable) -> entry when" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p", [Mod, Func, Args]), + Result = (catch ?LIB:dbg_apply(Mod, Func, [get | Args])), + %% mib shall return {value, <a-nice-value-within-range>} | + %% {noValue, noSuchName} (v1) | + %% {noValue, noSuchObject | noSuchInstance} (v2, v1) + %% everything else (including 'genErr') will generate 'genErr'. + ?AGENT:make_value_a_correct_value(Result, ASN1Type, {Mod, Func, Args}); + +get_var_value_from_mib(#me{entrytype = table_column, + oid = MeOid, + asn1_type = ASN1Type, + mfa = {Mod, Func, Args}}, + Oid) -> + ?vtrace("get_var_value_from_mib(table_column) -> entry when" + "~n MeOid: ~p" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p" + "~n Oid: ~p", [MeOid, Mod, Func, Args, Oid]), + Col = lists:last(MeOid), + Indexes = snmp_misc:diff(Oid, MeOid), + [Result] = (catch ?LIB:dbg_apply(Mod, Func, [get, Indexes, [Col] | Args])), + ?AGENT:make_value_a_correct_value(Result, ASN1Type, + {Mod, Func, Args, Indexes, Col}). + + +%% For table operations we need to pass RestOid down to the table-function. +%% Its up to the table-function to check for noSuchInstance (ex: a +%% non-existing row). +%% Returns: {error, ErrorStatus, OrgIndex} | +%% {value, Type, Value} +get_tab_value_from_mib(#me{mfa = {Mod, Func, Args}}, TableOid, TableVbs) -> + ?vtrace("get_tab_value_from_mib -> entry when" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p", [Mod, Func, Args]), + TableOpsWithShortOids = ?LIB:delete_prefixes(TableOid, TableVbs), + SortedVBsRows = snmpa_svbl:sort_varbinds_rows(TableOpsWithShortOids), + case get_value_all_rows(SortedVBsRows, Mod, Func, Args, []) of + {Error, Index} -> + #ivarbind{varbind = Vb} = lists:nth(Index, TableVbs), + {error, Error, Vb#varbind.org_index}; + ListOfValues -> + merge_varbinds_and_value(TableVbs, ListOfValues) + end. + +%%----------------------------------------------------------------- +%% Values is a scrambled list of {CorrectValue, Index}, where Index +%% is index into the #ivarbind list. So for each Value, we must +%% find the corresponding #ivarbind, and merge them into a new +%% #varbind. +%% The Values list comes from validate_tab_res. +%%----------------------------------------------------------------- +merge_varbinds_and_value(IVbs, [{{value, Type, Value}, Index} | Values]) -> + #ivarbind{varbind = Vb} = lists:nth(Index, IVbs), + [Vb#varbind{variabletype = Type, value = Value} | + merge_varbinds_and_value(IVbs, Values)]; +merge_varbinds_and_value(_, []) -> []. + +get_value_all_rows([{[], OrgCols} | Rows], Mod, Func, Args, Res) -> + ?vtrace("get_value_all_rows -> entry when" + "~n OrgCols: ~p", [OrgCols]), + Cols = [{{value, noValue, noSuchInstance}, Index} || + {_Col, _ASN1Type, Index} <- OrgCols], + NewRes = lists:append(Cols, Res), + get_value_all_rows(Rows, Mod, Func, Args, NewRes); +get_value_all_rows([{RowIndex, OrgCols} | Rows], Mod, Func, Args, Res) -> + ?vtrace("get_value_all_rows -> entry when" + "~n RowIndex: ~p" + "~n OrgCols: ~p", [RowIndex, OrgCols]), + {DOrgCols, Dup} = remove_duplicates(OrgCols), + Cols = delete_index(DOrgCols), + Result = (catch ?LIB:dbg_apply(Mod, Func, [get, RowIndex, Cols | Args])), + case validate_tab_res(Result, DOrgCols, {Mod, Func, Args}) of + Values when is_list(Values) -> + NVals = restore_duplicates(Dup, Values), + NewRes = lists:append(NVals, Res), + get_value_all_rows(Rows, Mod, Func, Args, NewRes); + {error, ErrorStatus, Index} -> + ?AGENT:validate_err(row_set, {ErrorStatus, Index}, {Mod, Func, Args}) + end; +get_value_all_rows([], _Mod, _Func, _Args, Res) -> + ?vtrace("get_value_all_rows -> entry when done" + "~n Res: ~p", [Res]), + Res. + +%%----------------------------------------------------------------- +%% Args: {RowIndex, list of {ShortOid, ASN1Type}} +%% Returns: list of Col +%%----------------------------------------------------------------- +delete_index([{Col, _Val, _OrgIndex} | T]) -> + [Col | delete_index(T)]; +delete_index([]) -> []. + +%%----------------------------------------------------------------- +%% This function is called before 'get' on a table, and removes +%% any duplicate columns. It returns {Cols, DupInfo}. The Cols +%% are the unique columns. The instrumentation function is +%% called to get the values. These values, together with the +%% DupInfo, is later passed to restore_duplicates, which uses +%% the retrieved values to reconstruct the original column list, +%% but with the retrieved value for each column. +%%----------------------------------------------------------------- +remove_duplicates(Cols) -> + remove_duplicates(Cols, [], []). + + +remove_duplicates([{Col, V1, OrgIdx1}, {Col, V2, OrgIdx2} | T], NCols, Dup) -> + remove_duplicates([{Col, V1, OrgIdx1} | T], NCols, + [{Col, V2, OrgIdx2} | Dup]); +remove_duplicates([Col | T], NCols, Dup) -> + remove_duplicates(T, [Col | NCols], Dup); +remove_duplicates([], NCols, Dup) -> + {lists:reverse(NCols), lists:reverse(Dup)}. + +restore_duplicates([], Cols) -> + [{Val, OrgIndex} || {_Col, Val, OrgIndex} <- Cols]; +restore_duplicates([{Col, _Val2, OrgIndex2} | Dup], + [{Col, NVal, OrgIndex1} | Cols]) -> + [{NVal, OrgIndex2} | + restore_duplicates(Dup, [{Col, NVal, OrgIndex1} | Cols])]; +restore_duplicates(Dup, [{_Col, Val, OrgIndex} | T]) -> + [{Val, OrgIndex} | restore_duplicates(Dup, T)]. + + + +%%----------------------------------------------------------------- +%% Three cases: +%% 1) All values ok +%% 2) table_func returned {Error, ...} +%% 3) Some value in Values list is erroneous. +%% Args: Value is a list of values from table_func(get..) +%% OrgCols is a list with {Col, ASN1Type, OrgIndex} +%% each element in Values and OrgCols correspond to each +%% other. +%%----------------------------------------------------------------- +validate_tab_res(Values, OrgCols, Mfa) when is_list(Values) -> + {_Col, _ASN1Type, OneIdx} = hd(OrgCols), + validate_tab_res(Values, OrgCols, Mfa, [], OneIdx); +validate_tab_res({noValue, Error}, OrgCols, Mfa) -> + Values = lists:duplicate(length(OrgCols), {noValue, Error}), + validate_tab_res(Values, OrgCols, Mfa); +validate_tab_res({genErr, Col}, OrgCols, Mfa) -> + case lists:keysearch(Col, 1, OrgCols) of + {value, {_Col, _ASN1Type, Index}} -> + {error, genErr, Index}; + _ -> + ?LIB:user_err("Invalid column in {genErr, ~w} from ~w (get)", + [Col, Mfa]), + [{_Col, _ASN1Type, Index} | _] = OrgCols, + {error, genErr, Index} + end; +validate_tab_res(genErr, [{_Col, __ASN1Type, Index} | _OrgCols], _Mfa) -> + {error, genErr, Index}; +validate_tab_res(Error, [{_Col, _ASN1Type, Index} | _OrgCols], Mfa) -> + ?LIB:user_err("Invalid return value ~w from ~w (get)",[Error, Mfa]), + {error, genErr, Index}. + +validate_tab_res([Value | Values], + [{Col, ASN1Type, Index} | OrgCols], + Mfa, Res, I) -> + %% This one makes it possible to return a list of genErr, which + %% is not allowed according to the manual. But that's ok, as + %% everything else will generate a genErr! (the only problem is + %% that it won't generate a user_error). + case ?AGENT:make_value_a_correct_value(Value, ASN1Type, Mfa) of + {error, ErrorStatus} -> + {error, ErrorStatus, Index}; + CorrectValue -> + NewRes = [{Col, CorrectValue, Index} | Res], + validate_tab_res(Values, OrgCols, Mfa, NewRes, I) + end; +validate_tab_res([], [], _Mfa, Res, _I) -> + lists:reverse(Res); +validate_tab_res([], [{_Col, _ASN1Type, Index}|_], Mfa, _Res, _I) -> + ?LIB:user_err("Too few values returned from ~w (get)", [Mfa]), + {error, genErr, Index}; +validate_tab_res(_TooMany, [], Mfa, _Res, I) -> + ?LIB:user_err("Too many values returned from ~w (get)", [Mfa]), + {error, genErr, I}. + + + +%%%----------------------------------------------------------------- +%%% 4. GET-NEXT REQUEST +%%% -------------- +%%% According to RFC1157, section 4.1.3 and RFC1905, section 4.2.2. +%%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Func: do_get_next/3 +%% Purpose: do_get_next handles "getNextRequests". +%% Note: Even if it is SNMPv1, a varbind's value can be +%% endOfMibView. This is converted to noSuchName in process_pdu. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%% Note2: ListOfNewVarbinds is not sorted in any order!!! +%% Alg: First, the variables are sorted in OID order. +%% +%% Second, next in the MIB is performed for each OID, and +%% the result is collected as: if next oid is a variable, +%% perform a get to retrieve its value; if next oid is in a +%% table, save this value and continue until we get an oid +%% outside this table. Then perform get_next on the table, +%% and continue with all endOfTables and the oid outside the +%% table; if next oid is an subagent, save this value and +%% continue as in the table case. +%% +%% Third, each response is checked for endOfMibView, or (for +%% subagents) that the Oid returned has the correct prefix. +%% (This is necessary since an SA can be registered under many +%% separated subtrees, and if the last variable in the first +%% subtree is requested in a next, the SA will return the first +%% variable in the second subtree. This might be working, since +%% there may be a variable in between these subtrees.) For each +%% of these, a new get-next is performed, one at a time. +%% This alg. might be optimised in several ways. The most +%% striking one is that the same SA might be called several +%% times, when one time should be enough. But it isn't clear +%% that this really matters, since many nexts across the same +%% subagent must be considered to be very rare. +%%----------------------------------------------------------------- + +do_get_next(MibView, UnsortedVBs, _Extra) -> + do_get_next2(MibView, UnsortedVBs, infinity). + +%% The third argument is only used if we are called as result +%% of a get-bulk request. +do_get_next2(_MibView, UnsortedVarbinds, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso (length(UnsortedVarbinds) > GbMaxVBs)) -> + {tooBig, 0, []}; % What is the correct index in this case? +do_get_next2(MibView, UnsortedVBs, GbMaxVBs) -> + ?vt("do_get_next2 -> entry when" + "~n MibView: ~p" + "~n UnsortedVBs: ~p", [MibView, UnsortedVBs]), + SortedVBs = ?LIB:oid_sort_vbs(UnsortedVBs), + ?vt("do_get_next -> " + "~n SortedVBs: ~p", [SortedVBs]), + next_loop_varbinds([], SortedVBs, MibView, [], [], GbMaxVBs). + +next_loop_varbinds(_, Vbs, _MibView, Res, _LAVb, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso + ((length(Vbs) + length(Res)) > GbMaxVBs)) -> + {tooBig, 0, []}; % What is the correct index in this case? + +%% LAVb is Last Accessible Vb +next_loop_varbinds([], [Vb | Vbs], MibView, Res, LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds -> entry when" + "~n Vb: ~p" + "~n MibView: ~p", [Vb, MibView]), + case varbind_next(Vb, MibView) of + endOfMibView -> + ?vt("next_loop_varbind -> endOfMibView", []), + RVb = if LAVb =:= [] -> Vb; + true -> LAVb + end, + NewVb = RVb#varbind{variabletype = 'NULL', value = endOfMibView}, + next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], GbMaxVBs); + + {variable, ME, VarOid} when ((ME#me.access =/= 'not-accessible') andalso + (ME#me.access =/= 'write-only') andalso + (ME#me.access =/= 'accessible-for-notify')) -> + ?vt("next_loop_varbind -> variable: " + "~n ME: ~p" + "~n VarOid: ~p", [ME, VarOid]), + case try_get_instance(Vb, ME) of + {value, noValue, _NoSuchSomething} -> + ?vt("next_loop_varbind -> noValue", []), + %% Try next one + NewVb = Vb#varbind{oid = VarOid, + value = 'NULL'}, + next_loop_varbinds([], [NewVb | Vbs], MibView, Res, [], + GbMaxVBs); + {value, Type, Value} -> + ?vt("next_loop_varbind -> value" + "~n Type: ~p" + "~n Value: ~p", [Type, Value]), + NewVb = Vb#varbind{oid = VarOid, + variabletype = Type, + value = Value}, + next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], + GbMaxVBs); + {error, ErrorStatus} -> + ?vdebug("next loop varbinds:" + "~n ErrorStatus: ~p",[ErrorStatus]), + {ErrorStatus, Vb#varbind.org_index, []} + end; + {variable, _ME, VarOid} -> + ?vt("next_loop_varbind -> variable: " + "~n VarOid: ~p", [VarOid]), + RVb = if LAVb =:= [] -> Vb; + true -> LAVb + end, + NewVb = Vb#varbind{oid = VarOid, value = 'NULL'}, + next_loop_varbinds([], [NewVb | Vbs], MibView, Res, RVb, GbMaxVBs); + {table, TableOid, TableRestOid, ME} -> + ?vt("next_loop_varbind -> table: " + "~n TableOid: ~p" + "~n TableRestOid: ~p" + "~n ME: ~p", [TableOid, TableRestOid, ME]), + next_loop_varbinds({table, TableOid, ME, + [{tab_oid(TableRestOid), Vb}]}, + Vbs, MibView, Res, [], GbMaxVBs); + {subagent, SubAgentPid, SAOid} -> + ?vt("next_loop_varbind -> subagent: " + "~n SubAgentPid: ~p" + "~n SAOid: ~p", [SubAgentPid, SAOid]), + NewVb = Vb#varbind{variabletype = 'NULL', value = 'NULL'}, + next_loop_varbinds({subagent, SubAgentPid, SAOid, [NewVb]}, + Vbs, MibView, Res, [], GbMaxVBs) + end; +next_loop_varbinds({table, TableOid, ME, TabOids}, + [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(table) -> entry with" + "~n TableOid: ~p" + "~n Vb: ~p", [TableOid, Vb]), + case varbind_next(Vb, MibView) of + {table, TableOid, TableRestOid, _ME} -> + next_loop_varbinds({table, TableOid, ME, + [{tab_oid(TableRestOid), Vb} | TabOids]}, + Vbs, MibView, Res, [], GbMaxVBs); + _ -> + case get_next_table(ME, TableOid, TabOids, MibView) of + {ok, TabRes, TabEndOfTabVbs} -> + NewVbs = lists:append(TabEndOfTabVbs, [Vb | Vbs]), + NewRes = lists:append(TabRes, Res), + next_loop_varbinds([], NewVbs, MibView, NewRes, [], + GbMaxVBs); + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next varbind" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end + end; +next_loop_varbinds({table, TableOid, ME, TabOids}, + [], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(table) -> entry with" + "~n TableOid: ~p", [TableOid]), + case get_next_table(ME, TableOid, TabOids, MibView) of + {ok, TabRes, TabEndOfTabVbs} -> + ?vt("next_loop_varbinds(table) -> get_next_table result:" + "~n TabRes: ~p" + "~n TabEndOfTabVbs: ~p", [TabRes, TabEndOfTabVbs]), + NewRes = lists:append(TabRes, Res), + next_loop_varbinds([], TabEndOfTabVbs, MibView, NewRes, [], + GbMaxVBs); + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next table" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end; +next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, + [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(subagent) -> entry with" + "~n SAPid: ~p" + "~n SAOid: ~p" + "~n Vb: ~p", [SAPid, SAOid, Vb]), + case varbind_next(Vb, MibView) of + {subagent, _SubAgentPid, SAOid} -> + next_loop_varbinds({subagent, SAPid, SAOid, + [Vb | SAVbs]}, + Vbs, MibView, Res, [], GbMaxVBs); + _ -> + case get_next_sa(SAPid, SAOid, SAVbs, MibView) of + {ok, SARes, SAEndOfMibViewVbs} -> + NewVbs = lists:append(SAEndOfMibViewVbs, [Vb | Vbs]), + NewRes = lists:append(SARes, Res), + next_loop_varbinds([], NewVbs, MibView, NewRes, [], + GbMaxVBs); + {noSuchName, OrgIndex} -> + %% v1 reply, treat this Vb as endOfMibView, and try again + %% for the others. + case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of + {value, EVb} -> + NextOid = next_oid(SAOid), + EndOfVb = + EVb#varbind{oid = NextOid, + value = {endOfMibView, NextOid}}, + case lists:delete(EVb, SAVbs) of + [] -> + next_loop_varbinds([], [EndOfVb, Vb | Vbs], + MibView, Res, [], + GbMaxVBs); + TryAgainVbs -> + next_loop_varbinds({subagent, SAPid, SAOid, + TryAgainVbs}, + [EndOfVb, Vb | Vbs], + MibView, Res, [], + GbMaxVBs) + end; + false -> + %% bad index from subagent + {genErr, (hd(SAVbs))#varbind.org_index, []} + end; + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next subagent" + "~n Vb: ~p" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [Vb,ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end + end; +next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, + [], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(subagent) -> entry with" + "~n SAPid: ~p" + "~n SAOid: ~p", [SAPid, SAOid]), + case get_next_sa(SAPid, SAOid, SAVbs, MibView) of + {ok, SARes, SAEndOfMibViewVbs} -> + NewRes = lists:append(SARes, Res), + next_loop_varbinds([], SAEndOfMibViewVbs, MibView, NewRes, [], + GbMaxVBs); + {noSuchName, OrgIndex} -> + %% v1 reply, treat this Vb as endOfMibView, and try again for + %% the others. + case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of + {value, EVb} -> + NextOid = next_oid(SAOid), + EndOfVb = EVb#varbind{oid = NextOid, + value = {endOfMibView, NextOid}}, + case lists:delete(EVb, SAVbs) of + [] -> + next_loop_varbinds([], [EndOfVb], MibView, Res, [], + GbMaxVBs); + TryAgainVbs -> + next_loop_varbinds({subagent, SAPid, SAOid, + TryAgainVbs}, + [EndOfVb], MibView, Res, [], + GbMaxVBs) + end; + false -> + %% bad index from subagent + {genErr, (hd(SAVbs))#varbind.org_index, []} + end; + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next subagent" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end; +next_loop_varbinds([], [], _MibView, Res, _LAVb, _GbMaxVBs) -> + ?vt("next_loop_varbinds -> entry when done", []), + {noError, 0, Res}. + +try_get_instance(_Vb, #me{mfa = {M, F, A}, asn1_type = ASN1Type}) -> + ?vtrace("try_get_instance -> entry with" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p", [M,F,A]), + Result = (catch ?LIB:dbg_apply(M, F, [get | A])), + % mib shall return {value, <a-nice-value-within-range>} | + % {noValue, noSuchName} (v1) | + % {noValue, noSuchObject | noSuchInstance} (v2, v1) + % everything else (including 'genErr') will generate 'genErr'. + ?AGENT:make_value_a_correct_value(Result, ASN1Type, {M, F, A}). + +tab_oid([]) -> [0]; +tab_oid(X) -> X. + + +%%----------------------------------------------------------------- +%% Perform a next, using the varbinds Oid if value is simple +%% value. If value is {endOf<something>, NextOid}, use NextOid. +%% This case happens when a table has returned endOfTable, or +%% a subagent has returned endOfMibView. +%%----------------------------------------------------------------- +varbind_next(#varbind{value = Value, oid = Oid}, MibView) -> + ?vt("varbind_next -> entry with" + "~n Value: ~p" + "~n Oid: ~p" + "~n MibView: ~p", [Value, Oid, MibView]), + case Value of + {endOfTable, NextOid} -> + snmpa_mib:next(get(mibserver), NextOid, MibView); + {endOfMibView, NextOid} -> + snmpa_mib:next(get(mibserver), NextOid, MibView); + _ -> + snmpa_mib:next(get(mibserver), Oid, MibView) + end. + +get_next_table(#me{mfa = {M, F, A}}, TableOid, TableOids, MibView) -> + % We know that all TableOids have at least a column number as oid + ?vt("get_next_table -> entry with" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p" + "~n TableOid: ~p" + "~n TableOids: ~p" + "~n MibView: ~p", [M, F, A, TableOid, TableOids, MibView]), + Sorted = snmpa_svbl:sort_varbinds_rows(TableOids), + case get_next_values_all_rows(Sorted, M,F,A, [], TableOid) of + NewVbs when is_list(NewVbs) -> + ?vt("get_next_table -> " + "~n NewVbs: ~p", [NewVbs]), + % We must now check each Vb for endOfTable and that it is + % in the MibView. If not, it becomes a endOfTable. We + % collect all of these together. + transform_tab_next_result(NewVbs, {[], []}, MibView); + {ErrorStatus, OrgIndex} -> + {ErrorStatus, OrgIndex} + end. + +get_next_values_all_rows([Row | Rows], M, F, A, Res, TabOid) -> + {RowIndex, TableOids} = Row, + Cols = delete_index(TableOids), + ?vt("get_next_values_all_rows -> " + "~n Cols: ~p", [Cols]), + Result = (catch ?LIB:dbg_apply(M, F, [get_next, RowIndex, Cols | A])), + ?vt("get_next_values_all_rows -> " + "~n Result: ~p", [Result]), + case validate_tab_next_res(Result, TableOids, {M, F, A}, TabOid) of + Values when is_list(Values) -> + ?vt("get_next_values_all_rows -> " + "~n Values: ~p", [Values]), + NewRes = lists:append(Values, Res), + get_next_values_all_rows(Rows, M, F, A, NewRes, TabOid); + {ErrorStatus, OrgIndex} -> + {ErrorStatus, OrgIndex} + end; +get_next_values_all_rows([], _M, _F, _A, Res, _TabOid) -> + Res. + +transform_tab_next_result([Vb | Vbs], {Res, EndOfs}, MibView) -> + case Vb#varbind.value of + {endOfTable, _} -> + {ResVBs, EndOfVBs} = ?LIB:split_vbs(Vbs, Res, [Vb | EndOfs]), + {ok, ResVBs, EndOfVBs}; + _ -> + case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of + true -> + transform_tab_next_result(Vbs, {[Vb|Res], EndOfs},MibView); + _ -> + Oid = Vb#varbind.oid, + NewEndOf = Vb#varbind{value = {endOfTable, Oid}}, + transform_tab_next_result(Vbs, {Res, [NewEndOf | EndOfs]}, + MibView) + end + end; +transform_tab_next_result([], {Res, EndOfs}, _MibView) -> + ?vt("transform_tab_next_result -> entry with: " + "~n Res: ~p" + "~n EndIfs: ~p",[Res, EndOfs]), + {ok, Res, EndOfs}. + + + +%%----------------------------------------------------------------- +%% Three cases: +%% 1) All values ok +%% 2) table_func returned {Error, ...} +%% 3) Some value in Values list is erroneous. +%% Args: Value is a list of values from table_func(get_next, ...) +%% TableOids is a list of {TabRestOid, OrgVb} +%% each element in Values and TableOids correspond to each +%% other. +%% Returns: List of NewVarbinds | +%% {ErrorStatus, OrgIndex} +%% (In the NewVarbinds list, the value may be endOfTable) +%%----------------------------------------------------------------- +validate_tab_next_res(Values, TableOids, Mfa, TabOid) -> + ?vt("validate_tab_next_res -> entry with: " + "~n Values: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n TabOid: ~p", [Values, TableOids, Mfa, TabOid]), + {_Col, _ASN1Type, OneIdx} = hd(TableOids), + validate_tab_next_res(Values, TableOids, Mfa, [], TabOid, + next_oid(TabOid), OneIdx). +validate_tab_next_res([{NextOid, Value} | Values], + [{_ColNo, OrgVb, _Index} | TableOids], + Mfa, Res, TabOid, TabNextOid, I) -> + ?vt("validate_tab_next_res -> entry with: " + "~n NextOid: ~p" + "~n Value: ~p" + "~n Values: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n TabOid: ~p", + [NextOid, Value, Values, TableOids, Mfa, TabOid]), + #varbind{org_index = OrgIndex} = OrgVb, + ?vt("validate_tab_next_res -> OrgIndex: ~p", [OrgIndex]), + NextCompleteOid = lists:append(TabOid, NextOid), + case snmpa_mib:lookup(get(mibserver), NextCompleteOid) of + {table_column, #me{asn1_type = ASN1Type}, _TableEntryOid} -> + ?vt("validate_tab_next_res -> ASN1Type: ~p", [ASN1Type]), + case ?AGENT:make_value_a_correct_value({value, Value}, ASN1Type, Mfa) of + {error, ErrorStatus} -> + ?vt("validate_tab_next_res -> " + "~n ErrorStatus: ~p", [ErrorStatus]), + {ErrorStatus, OrgIndex}; + {value, Type, NValue} -> + ?vt("validate_tab_next_res -> " + "~n Type: ~p" + "~n NValue: ~p", [Type, NValue]), + NewVb = OrgVb#varbind{oid = NextCompleteOid, + variabletype = Type, value = NValue}, + validate_tab_next_res(Values, TableOids, Mfa, + [NewVb | Res], TabOid, TabNextOid, I) + end; + Error -> + ?LIB:user_err("Invalid oid ~w from ~w (get_next). Using genErr => ~p", + [NextOid, Mfa, Error]), + {genErr, OrgIndex} + end; +validate_tab_next_res([endOfTable | Values], + [{_ColNo, OrgVb, _Index} | TableOids], + Mfa, Res, TabOid, TabNextOid, I) -> + ?vt("validate_tab_next_res(endOfTable) -> entry with: " + "~n Values: ~p" + "~n OrgVb: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n Res: ~p" + "~n TabOid: ~p" + "~n TabNextOid: ~p" + "~n I: ~p", + [Values, OrgVb, TableOids, Mfa, Res, TabOid, TabNextOid, I]), + NewVb = OrgVb#varbind{value = {endOfTable, TabNextOid}}, + validate_tab_next_res(Values, TableOids, Mfa, [NewVb | Res], + TabOid, TabNextOid, I); +validate_tab_next_res([], [], _Mfa, Res, _TabOid, _TabNextOid, _I) -> + Res; +validate_tab_next_res([], [{_Col, _OrgVb, Index}|_], Mfa, _Res, _, _, _I) -> + ?LIB:user_err("Too few values returned from ~w (get_next)", [Mfa]), + {genErr, Index}; +validate_tab_next_res({genErr, ColNumber}, OrgCols, + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + OrgIndex = snmpa_svbl:col_to_orgindex(ColNumber, OrgCols), + ?AGENT:validate_err(table_next, {genErr, OrgIndex}, Mfa); +validate_tab_next_res({error, Reason}, [{_ColNo, OrgVb, _Index} | _TableOids], + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + #varbind{org_index = OrgIndex} = OrgVb, + ?LIB:user_err("Erroneous return value ~w from ~w (get_next)", + [Reason, Mfa]), + {genErr, OrgIndex}; +validate_tab_next_res(Error, [{_ColNo, OrgVb, _Index} | _TableOids], + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + #varbind{org_index = OrgIndex} = OrgVb, + ?LIB:user_err("Invalid return value ~w from ~w (get_next)", + [Error, Mfa]), + {genErr, OrgIndex}; +validate_tab_next_res(TooMany, [], Mfa, _Res, _, _, I) -> + ?LIB:user_err("Too many values ~w returned from ~w (get_next)", + [TooMany, Mfa]), + {genErr, I}. + +%%----------------------------------------------------------------- +%% Func: get_next_sa/4 +%% Purpose: Loop the list of varbinds for the subagent. +%% Call subagent_get_next to retreive +%% the next varbinds. +%% Returns: {ok, ListOfNewVbs, ListOfEndOfMibViewsVbs} | +%% {ErrorStatus, ErrorIndex} +%%----------------------------------------------------------------- +get_next_sa(SAPid, SAOid, SAVbs, MibView) -> + case catch ?AGENT:subagent_get_next(SAPid, MibView, SAVbs) of + {noError, 0, NewVbs} -> + NewerVbs = transform_sa_next_result(NewVbs,SAOid,next_oid(SAOid)), + {ResVBs, EndOfVBs} = ?LIB:split_vbs(NewerVbs), + {ok, ResVBs, EndOfVBs}; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex}; + {'EXIT', Reason} -> + ?LIB:user_err("Lost contact with subagent (next) ~w. Using genErr", + [Reason]), + {genErr, 0} + end. + +%%----------------------------------------------------------------- +%% Check for wrong prefix returned or endOfMibView, and convert +%% into {endOfMibView, SANextOid}. +%%----------------------------------------------------------------- +transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) + when Vb#varbind.value =:= endOfMibView -> + [Vb#varbind{value = {endOfMibView, SANextOid}} | + transform_sa_next_result(Vbs, SAOid, SANextOid)]; +transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) -> + case lists:prefix(SAOid, Vb#varbind.oid) of + true -> + [Vb | transform_sa_next_result(Vbs, SAOid, SANextOid)]; + _ -> + [Vb#varbind{oid = SANextOid, value = {endOfMibView, SANextOid}} | + transform_sa_next_result(Vbs, SAOid, SANextOid)] + end; +transform_sa_next_result([], _SAOid, _SANextOid) -> + []. + + +next_oid(Oid) -> + case lists:reverse(Oid) of + [H | T] -> lists:reverse([H+1 | T]); + [] -> [] + end. + + + +%%%----------------------------------------------------------------- +%%% 5. GET-BULK REQUEST +%%% +%%% In order to prevent excesses in reply sizes there are two +%%% preventive methods in place. One is to check that the encode +%%% size does not exceed Max PDU size (this is mentioned in the +%%% standard). The other is a simple VBs limit. That is, the +%%% resulting response cannot contain more then this number of VBs. +%%%----------------------------------------------------------------- + +do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, _Extra) -> + ?vtrace("do_get_bulk -> entry with" + "~n MibView: ~p" + "~n NonRepeaters: ~p" + "~n MaxRepetitions: ~p" + "~n PduMS: ~p" + "~n Varbinds: ~p" + "~n GbMaxVBs: ~p", + [MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs]), + {NonRepVbs, RestVbs} = ?LIB:split_vbs_gb(NonRepeaters, Varbinds), + ?vt("do_get_bulk -> split: " + "~n NonRepVbs: ~p" + "~n RestVbs: ~p", [NonRepVbs, RestVbs]), + case do_get_next2(MibView, NonRepVbs, GbMaxVBs) of + {noError, 0, UResNonRepVbs} -> + ?vt("do_get_bulk -> next noError: " + "~n UResNonRepVbs: ~p", [UResNonRepVbs]), + ResNonRepVbs = lists:keysort(#varbind.org_index, UResNonRepVbs), + %% Decode the first varbinds, produce a reversed list of + %% listOfBytes. + case (catch enc_vbs(PduMS - ?empty_pdu_size, ResNonRepVbs)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), + {genErr, Idx, []}; + {SizeLeft, Res} when is_integer(SizeLeft) and is_list(Res) -> + ?vtrace("do_get_bulk -> encoded: " + "~n SizeLeft: ~p" + "~n Res: ~w", [SizeLeft, Res]), + case (catch do_get_rep(SizeLeft, MibView, MaxRepetitions, + RestVbs, Res, + length(UResNonRepVbs), GbMaxVBs)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", + [Idx, Reason]), + {genErr, Idx, []}; + Res when is_list(Res) -> + ?vtrace("do get bulk -> Res: " + "~n ~w", [Res]), + {noError, 0, conv_res(Res)}; + {noError, 0, Data} = OK -> + ?vtrace("do get bulk -> OK: " + "~n length(Data): ~w", [length(Data)]), + OK; + Else -> + ?vtrace("do get bulk -> Else: " + "~n ~w", [Else]), + Else + end; + Res when is_list(Res) -> + {noError, 0, conv_res(Res)} + end; + + {ErrorStatus, Index, _} -> + ?vdebug("do get bulk: " + "~n ErrorStatus: ~p" + "~n Index: ~p",[ErrorStatus, Index]), + {ErrorStatus, Index, []} + end. + +enc_vbs(SizeLeft, Vbs) -> + ?vt("enc_vbs -> entry with" + "~n SizeLeft: ~w", [SizeLeft]), + Fun = fun(Vb, {Sz, Res}) when Sz > 0 -> + ?vt("enc_vbs -> (fun) entry with" + "~n Vb: ~p" + "~n Sz: ~p" + "~n Res: ~w", [Vb, Sz, Res]), + case (catch snmp_pdus:enc_varbind(Vb)) of + {'EXIT', Reason} -> + ?vtrace("enc_vbs -> encode failed: " + "~n Reason: ~p", [Reason]), + throw({error, Vb#varbind.org_index, Reason}); + X -> + ?vt("enc_vbs -> X: ~w", [X]), + Lx = length(X), + ?vt("enc_vbs -> Lx: ~w", [Lx]), + if + Lx < Sz -> + {Sz - length(X), [X | Res]}; + true -> + throw(Res) + end + end; + (_Vb, {_Sz, [_H | T]}) -> + ?vt("enc_vbs -> (fun) entry with" + "~n T: ~p", [T]), + throw(T); + (_Vb, {_Sz, []}) -> + ?vt("enc_vbs -> (fun) entry", []), + throw([]) + end, + lists:foldl(Fun, {SizeLeft, []}, Vbs). + +do_get_rep(Sz, MibView, MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) + when MaxRepetitions >= 0 -> + do_get_rep(Sz, MibView, 0, MaxRepetitions, Varbinds, Res, + GbNumVBs, GbMaxVBs); +do_get_rep(Sz, MibView, _MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) -> + do_get_rep(Sz, MibView, 0, 0, Varbinds, Res, GbNumVBs, GbMaxVBs). + +conv_res(ResVarbinds) -> + conv_res(ResVarbinds, []). +conv_res([VbListOfBytes | T], Bytes) -> + conv_res(T, VbListOfBytes ++ Bytes); +conv_res([], Bytes) -> + Bytes. + +%% The only other value, then a positive integer, is infinity. +do_get_rep(_Sz, _MibView, Count, Max, _, _Res, GbNumVBs, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso (GbNumVBs > GbMaxVBs)) -> + ?vinfo("Max Get-BULK VBs limit (~w) exceeded (~w) when:" + "~n Count: ~p" + "~n Max: ~p", [GbMaxVBs, GbNumVBs, Count, Max]), + {tooBig, 0, []}; +do_get_rep(_Sz, _MibView, Max, Max, _, Res, _GbNumVBs, _GbMaxVBs) -> + ?vt("do_get_rep -> done when: " + "~n Res: ~p", [Res]), + {noError, 0, conv_res(Res)}; +do_get_rep(Sz, MibView, Count, Max, Varbinds, Res, GbNumVBs, GbMaxVBs) -> + ?vt("do_get_rep -> entry when: " + "~n Sz: ~p" + "~n Count: ~p" + "~n Res: ~w", [Sz, Count, Res]), + case try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) of + {noError, NextVarbinds, SizeLeft, Res2} -> + ?vt("do_get_rep -> noError: " + "~n SizeLeft: ~p" + "~n Res2: ~p", [SizeLeft, Res2]), + do_get_rep(SizeLeft, MibView, Count+1, Max, NextVarbinds, + Res2 ++ Res, + GbNumVBs + length(Varbinds), GbMaxVBs); + {endOfMibView, _NextVarbinds, _SizeLeft, Res2} -> + ?vt("do_get_rep -> endOfMibView: " + "~n Res2: ~p", [Res2]), + {noError, 0, conv_res(Res2 ++ Res)}; + {ErrorStatus, Index} -> + ?vtrace("do_get_rep -> done when error: " + "~n ErrorStatus: ~p" + "~n Index: ~p", [ErrorStatus, Index]), + {ErrorStatus, Index, []} + end. + +try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) -> + ?vt("try_get_bulk -> entry with" + "~n Sz: ~w" + "~n MibView: ~w" + "~n Varbinds: ~w", [Sz, MibView, Varbinds]), + case do_get_next2(MibView, Varbinds, GbMaxVBs) of + {noError, 0, UNextVarbinds} -> + ?vt("try_get_bulk -> noError: " + "~n UNextVarbinds: ~p", [UNextVarbinds]), + NextVarbinds = ?LIB:org_index_sort_vbs(UNextVarbinds), + case (catch enc_vbs(Sz, NextVarbinds)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), + ?vtrace("try_get_bulk -> encode error: " + "~n Idx: ~p" + "~n Reason: ~p", [Idx, Reason]), + {genErr, Idx}; + {SizeLeft, Res} when is_integer(SizeLeft) andalso + is_list(Res) -> + ?vt("try get bulk -> encode ok: " + "~n SizeLeft: ~w" + "~n Res: ~w", [SizeLeft, Res]), + {check_end_of_mibview(NextVarbinds), + NextVarbinds, SizeLeft, Res}; + Res when is_list(Res) -> + ?vt("try get bulk -> Res: " + "~n ~w", [Res]), + {endOfMibView, [], 0, Res} + end; + {ErrorStatus, Index, _} -> + ?vt("try_get_bulk -> error: " + "~n ErrorStatus: ~p" + "~n Index: ~p", [ErrorStatus, Index]), + {ErrorStatus, Index} + end. + +%% If all variables in this pass are endOfMibView, +%% there is no reason to continue. +check_end_of_mibview([#varbind{value = endOfMibView} | T]) -> + check_end_of_mibview(T); +check_end_of_mibview([]) -> endOfMibView; +check_end_of_mibview(_) -> noError. + + + diff --git a/lib/snmp/src/agent/snmpa_get_lib.erl b/lib/snmp/src/agent/snmpa_get_lib.erl new file mode 100644 index 0000000000..eaf7fe2641 --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get_lib.erl @@ -0,0 +1,254 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-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. +%% 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% +%% + +%% +%% Note that most of these functions *assume* that they are executed +%% by the agent. If they are not they may note work as they require +%% some properties to be set in the process dictionary! +%% + +-module(snmpa_get_lib). + +-export([ + split_vbs/1, split_vbs/3, + split_vbs_view/2, + split_vbs_gb/2, + + agent_sort_vbs/1, + oid_sort_vbs/1, org_index_sort_vbs/1, + + sa_split/1, + + delete_prefixes/2, + + dbg_apply/3, + + user_err/2 + ]). + +-define(VMODULE,"GET-LIB"). +-include("snmpa_internal.hrl"). +-include("snmp_types.hrl"). +-include("snmp_debug.hrl"). +-include("snmp_verbosity.hrl"). + + + + +%%----------------------------------------------------------------- +%% split_vbs/1,3 +%% +%% Splits the list of varbinds (basically) into two lists. One +%% of 'end of'-varbinds (mib view and tables) and then the rest +%% of the varbinds. +%%----------------------------------------------------------------- + +-spec split_vbs(VBs :: [snmp:varbind()]) -> + {ResVBs :: [snmp:varbind()], + EndOfVBs :: [snmp:varbind()]}. + +split_vbs(VBs) -> + split_vbs(VBs, [], []). + +-spec split_vbs(VBs :: [snmp:varbind()], + Res :: [snmp:varbind()], + EndOfs :: [snmp:varbind()]) -> + {ResVBs :: [snmp:varbind()], + EndOfVBs :: [snmp:varbind()]}. + +split_vbs([], ResVBs, EndOfVBs) -> + {ResVBs, EndOfVBs}; +split_vbs([VB | VBs], Res, EndOfs) -> + case VB#varbind.value of + {endOfMibView, _} -> split_vbs(VBs, Res, [VB | EndOfs]); + {endOfTable, _} -> split_vbs(VBs, Res, [VB | EndOfs]); + _ -> split_vbs(VBs, [VB | Res], EndOfs) + end. + + + +%%----------------------------------------------------------------- +%% split_vbs_view/2 +%% +%% Splits a list of varbinds into two lists based on the provided +%% MibView. One list of varbinds inside the MibView and one of +%% varbinds outside the MibView. +%%----------------------------------------------------------------- + +-spec split_vbs_view(VBs :: [snmp:varbind()], + MibView :: snmp_view_based_acm_mib:mibview()) -> + {OutSideView :: [snmp:varbind()], + InSideView :: [snmp:varbind()]}. + +split_vbs_view(VBs, MibView) -> + ?vtrace("split the varbinds view", []), + split_vbs_view(VBs, MibView, [], []). + +split_vbs_view([], _MibView, Out, In) -> + {Out, In}; +split_vbs_view([VB | VBs], MibView, Out, In) -> + case snmpa_acm:validate_mib_view(VB#varbind.oid, MibView) of + true -> + split_vbs_view(VBs, MibView, Out, [VB | In]); + false -> + VB2 = VB#varbind{value = noSuchObject}, + split_vbs_view(VBs, MibView, [VB2 | Out], In) + end. + + + +%%----------------------------------------------------------------- +%% split_vbs_gb/2 +%% +%% Performs a get-bulk split of the varbinds +%%----------------------------------------------------------------- + +-spec split_vbs_gb(NonRepeaters :: integer(), + VBs :: [snmp:varbind()]) -> + {NonRepVBs :: [snmp:varbind()], + RestVBs :: [snmp:varbind()]}. + +split_vbs_gb(N, VBs) -> + split_vbs_gb(N, VBs, []). + +split_vbs_gb(N, Varbinds, Res) when N =< 0 -> + {Res, Varbinds}; +split_vbs_gb(N, [H | T], Res) -> + split_vbs_gb(N-1, T, [H | Res]); +split_vbs_gb(_N, [], Res) -> + {Res, []}. + + + +%%----------------------------------------------------------------- +%% agent_sort_vbs/1 +%% +%% Sorts the varbinds into two categories. The first is varbinds +%% belonging to "our" agent and the other is varbinds for +%% subagents. +%%----------------------------------------------------------------- + +-spec agent_sort_vbs(VBs :: [snmp:varbind()]) -> + {AgentVBs :: [snmp:varbind()], + SubAgentVBs :: [snmp:varbind()]}. + +agent_sort_vbs(VBs) -> + snmpa_svbl:sort_varbindlist(get(mibserver), VBs). + + +%%----------------------------------------------------------------- +%% oid_sort_vbs/1 +%% +%% Sorts the varbinds based on their oid. +%%----------------------------------------------------------------- + +-spec oid_sort_vbs(VBs :: [snmp:varbind()]) -> SortedVBs :: [snmp:varbind()]. + +oid_sort_vbs(VBs) -> + lists:keysort(#varbind.oid, VBs). + + +%%----------------------------------------------------------------- +%% org_index_sort_vbs/1 +%% +%% Sorts the varbinds based on their org_index. +%%----------------------------------------------------------------- + +-spec org_index_sort_vbs(VBs :: [snmp:varbind()]) -> SortedVBs :: [snmp:varbind()]. + +org_index_sort_vbs(Vbs) -> + lists:keysort(#varbind.org_index, Vbs). + + + +%%----------------------------------------------------------------- +%% sa_split/1 +%% +%% Splits a list of {oid(), varbind()} into two lists of oid() +%% and varbind. The resulting lists are reversed! +%%----------------------------------------------------------------- + +-spec sa_split(SAVBs :: [{SAOid :: snmp:oid(), snmp:varbind()}]) -> + {Oids :: [snmp:oid()], VBs :: [snmp:varbind()]}. + +sa_split(SAVBs) -> + snmpa_svbl:sa_split(SAVBs). + + + +%%----------------------------------------------------------------- +%% delete_prefixes/2 +%% +%% Takes an Oid prefix and a list of ivarbinds and produces a list +%% of {ShortOid, ASN1Type}. The ShortOid is basically the oid with +%% the OidPrefix removed. +%%----------------------------------------------------------------- + +-spec delete_prefixes(OidPrefix :: snmp:oid(), + VBs :: [snmp:ivarbind()]) -> + [{ShortOid :: snmp:oid(), + ASN1Type :: snmp:asn1_type()}]. + +delete_prefixes(OidPrefix, IVBs) -> + [{snmp_misc:diff(Oid, OidPrefix), ME#me.asn1_type} || + #ivarbind{varbind = #varbind{oid = Oid}, mibentry = ME} <- IVBs]. + + + +%%----------------------------------------------------------------- +%% dbg_apply/3 +%% +%% Call instrumentation functions, but allow for debug printing +%% of useful debug info. +%%----------------------------------------------------------------- + +-spec dbg_apply(M :: atom(), F :: atom(), A :: list()) -> + any(). + +dbg_apply(M, F, A) -> + case get(verbosity) of + silence -> + apply(M,F,A); + _ -> + ?vlog("~n apply: ~w, ~w, ~p~n", [M,F,A]), + Res = (catch apply(M,F,A)), + case Res of + {'EXIT', Reason} -> + ?vinfo("Call to: " + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p" + "~n" + "~nresulted in an exit" + "~n" + "~n ~p~n", [M, F, A, Reason]); + _ -> + ?vlog("~n returned: ~p~n", [Res]) + end, + Res + end. + + +%% --------------------------------------------------------------------- + +user_err(F, A) -> + snmpa_error:user_err(F, A). + + diff --git a/lib/snmp/src/agent/snmpa_get_mechanism.erl b/lib/snmp/src/agent/snmpa_get_mechanism.erl new file mode 100644 index 0000000000..744a6529e1 --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get_mechanism.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-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. +%% 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(snmpa_get_mechanism). + +%% +%% This module defines the behaviour for the undocumented (hidden) +%% get-mechanism feature. This allows for implementing your own +%% handling of get, get-next and get-bulk requests. +%% Probably only useful for special cases (e.g. optimization). +%% + + + +%% ----------- do_get/2,3 ----------------------------------------------------- + +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). + +-callback do_get(UnsortedVBs :: [snmp:varbind()], + IsNotification :: boolean(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + +%% Purpose: Handles "get-requests". + +-callback do_get(MibView :: snmp_view_based_acm_mib:mibview(), + UnsortedVBs :: [snmp:varbind()], + IsNotification :: boolean(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + + + +%% ----------- do_get_next/2 ------------------------------------------------ + +%% Purpose: Handles "get-next-requests". + +-callback do_get_next(MibView :: snmp_view_based_acm_mib:mibview(), + UnsortedVBs :: [snmp:varbind()], + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + + + +%% ----------- do_get_bulk/6 ------------------------------------------------ + +-callback do_get_bulk(MibView :: snmp_view_based_acm_mib:mibview(), + NonRepeaters :: non_neg_integer(), + MaxRepetitions :: non_neg_integer(), + PduMS :: pos_integer(), + VBs :: [snmp:varbind()], + MaxVBs :: pos_integer(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. 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/agent/snmpa_set_lib.erl b/lib/snmp/src/agent/snmpa_set_lib.erl index 97b8ddf7c4..94120f4c7d 100644 --- a/lib/snmp/src/agent/snmpa_set_lib.erl +++ b/lib/snmp/src/agent/snmpa_set_lib.erl @@ -390,7 +390,7 @@ dbg_apply(M,F,A) -> {'EXIT', {function_clause, [{M, F, A} | _]}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; - % XYZ: Older format for compatibility + %% XYZ: Older format for compatibility {'EXIT', {undef, {M, F, A}}} -> {'EXIT', {hook_undef, {M, F, A}}}; {'EXIT', {function_clause, {M, F, A}}} -> diff --git a/lib/snmp/src/agent/snmpa_supervisor.erl b/lib/snmp/src/agent/snmpa_supervisor.erl index cdb5ca840d..2cb0556001 100644 --- a/lib/snmp/src/agent/snmpa_supervisor.erl +++ b/lib/snmp/src/agent/snmpa_supervisor.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. @@ -193,36 +193,36 @@ init([AgentType, Opts]) -> ?vdebug("agent restart type: ~w", [Restart]), %% -- Agent type -- - ets:insert(snmp_agent_table, {agent_type, AgentType}), + store(agent_type, AgentType), %% -- Prio -- Prio = get_opt(priority, Opts, normal), ?vdebug("[agent table] store priority: ~p",[Prio]), - ets:insert(snmp_agent_table, {priority, Prio}), + store(priority, Prio), %% -- Versions -- Vsns = get_opt(versions, Opts, [v1,v2,v3]), ?vdebug("[agent table] store versions: ~p",[Vsns]), - ets:insert(snmp_agent_table, {versions, Vsns}), + store(versions, Vsns), %% -- Max number of VBs in a Get-BULK response -- GbMaxVBs = get_gb_max_vbs(Opts), ?vdebug("[agent table] Get-BULK max VBs: ~p", [GbMaxVBs]), - ets:insert(snmp_agent_table, {gb_max_vbs, GbMaxVBs}), + store(gb_max_vbs, GbMaxVBs), %% -- DB-directory -- DbDir = get_opt(db_dir, Opts), ?vdebug("[agent table] store db_dir: ~n ~p",[DbDir]), - ets:insert(snmp_agent_table, {db_dir, filename:join([DbDir])}), + store(db_dir, filename:join([DbDir])), DbInitError = get_opt(db_init_error, Opts, terminate), ?vdebug("[agent table] store db_init_error: ~n ~p",[DbInitError]), - ets:insert(snmp_agent_table, {db_init_error, DbInitError}), + store(db_init_error, DbInitError), %% -- Error report module -- ErrorReportMod = get_opt(error_report_mod, Opts, snmpa_error_logger), ?vdebug("[agent table] store error report module: ~w",[ErrorReportMod]), - ets:insert(snmp_agent_table, {error_report_mod, ErrorReportMod}), + store(error_report_mod, ErrorReportMod), %% -- mib storage -- %% MibStorage has only one mandatory part: module @@ -320,31 +320,31 @@ init([AgentType, Opts]) -> end, ?vdebug("[agent table] store mib storage: ~w", [MibStorage]), - ets:insert(snmp_agent_table, {mib_storage, MibStorage}), + store(mib_storage, MibStorage), %% -- Agent mib storage -- AgentMibStorage = get_opt(agent_mib_storage, Opts, persistent), %% ?vdebug("[agent table] store agent mib storage: ~w",[AgentMibStorage]), - ets:insert(snmp_agent_table, {agent_mib_storage, AgentMibStorage}), + store(agent_mib_storage, AgentMibStorage), %% -- System start time -- ?vdebug("[agent table] store system start time",[]), - ets:insert(snmp_agent_table, {system_start_time, snmp_misc:now(cs)}), + store(system_start_time, snmp_misc:now(cs)), %% -- Symbolic store options -- SsOpts = get_opt(symbolic_store, Opts, []), ?vdebug("[agent table] store symbolic store options: ~w",[SsOpts]), - ets:insert(snmp_agent_table, {symbolic_store, SsOpts}), + store(symbolic_store, SsOpts), %% -- Local DB options -- LdbOpts = get_opt(local_db, Opts, []), ?vdebug("[agent table] store local db options: ~w",[LdbOpts]), - ets:insert(snmp_agent_table, {local_db, LdbOpts}), + store(local_db, LdbOpts), %% -- Target cache options -- TargetCacheOpts = get_opt(target_cache, Opts, []), ?vdebug("[agent table] store target cache options: ~w",[TargetCacheOpts]), - ets:insert(snmp_agent_table, {target_cache, TargetCacheOpts}), + store(target_cache, TargetCacheOpts), %% -- Specs -- SupFlags = {one_for_all, 0, 3600}, @@ -377,7 +377,7 @@ init([AgentType, Opts]) -> %% -- Config -- ConfOpts = get_opt(config, Opts, []), ?vdebug("[agent table] store config options: ~p", [ConfOpts]), - ets:insert(snmp_agent_table, {config, ConfOpts}), + store(config, ConfOpts), ConfigArgs = [Vsns, ConfOpts], ConfigSpec = @@ -390,43 +390,46 @@ init([AgentType, Opts]) -> %% -- Discovery processing -- DiscoOpts = get_opt(discovery, Opts, []), ?vdebug("[agent table] store discovery options: ~p", [DiscoOpts]), - ets:insert(snmp_agent_table, {discovery, DiscoOpts}), + store(discovery, DiscoOpts), %% -- Mibs -- Mibs = get_mibs(get_opt(mibs, Opts, []), Vsns), ?vdebug("[agent table] store mibs: ~n ~p",[Mibs]), - ets:insert(snmp_agent_table, {mibs, Mibs}), + store(mibs, Mibs), Ref = make_ref(), + %% -- Get module -- + GetModule = get_opt(get_mechanism, Opts, snmpa_get), + ?vdebug("[agent table] store get-module: ~p", [GetModule]), + store(get_mechanism, GetModule), + %% -- Set module -- SetModule = get_opt(set_mechanism, Opts, snmpa_set), ?vdebug("[agent table] store set-module: ~p",[SetModule]), - ets:insert(snmp_agent_table, {set_mechanism, ConfOpts}), + store(set_mechanism, SetModule), %% -- Authentication service -- AuthModule = get_opt(authentication_service, Opts, snmpa_acm), ?vdebug("[agent table] store authentication service: ~w", [AuthModule]), - ets:insert(snmp_agent_table, - {authentication_service, AuthModule}), + store(authentication_service, AuthModule), %% -- Multi-threaded -- MultiT = get_opt(multi_threaded, Opts, false), - ?vdebug("[agent table] store multi-threaded: ~p",[MultiT]), - ets:insert(snmp_agent_table, {multi_threaded, MultiT}), + ?vdebug("[agent table] store multi-threaded: ~p", [MultiT]), + store(multi_threaded, MultiT), %% -- Audit trail log -- case get_opt(audit_trail_log, Opts, not_found) of not_found -> - ?vdebug("[agent table] no audit trail log",[]), + ?vdebug("[agent table] no audit trail log", []), ok; AtlOpts -> ?vdebug("[agent table] " "store audit trail log options: ~p", [AtlOpts]), - ets:insert(snmp_agent_table, - {audit_trail_log, AtlOpts}), + store(audit_trail_log, AtlOpts), ok end, @@ -434,24 +437,25 @@ init([AgentType, Opts]) -> MibsOpts = get_opt(mib_server, Opts, []), ?vdebug("[agent table] store mib-server options: " "~n ~p", [MibsOpts]), - ets:insert(snmp_agent_table, {mib_server, MibsOpts}), + store(mib_server, MibsOpts), %% -- Network interface -- NiOpts = get_opt(net_if, Opts, []), ?vdebug("[agent table] store net-if options: " "~n ~p", [NiOpts]), - ets:insert(snmp_agent_table, {net_if, NiOpts}), + store(net_if, NiOpts), %% -- Note store -- NsOpts = get_opt(note_store, Opts, []), ?vdebug("[agent table] store note-store options: " "~n ~p",[NsOpts]), - ets:insert(snmp_agent_table, {note_store, NsOpts}), + store(note_store, NsOpts), AgentOpts = [{verbosity, AgentVerb}, {mibs, Mibs}, {mib_storage, MibStorage}, + {get_mechanism, GetModule}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {multi_threaded, MultiT}, @@ -480,6 +484,10 @@ init([AgentType, Opts]) -> {ok, {SupFlags, [MiscSupSpec, SymStoreSpec, LocalDbSpec, TargetCacheSpec | Rest]}}. + +store(Key, Value) -> + ets:insert(snmp_agent_table, {Key, Value}). + get_mibs(Mibs, Vsns) -> MibDir = filename:join(code:priv_dir(snmp), "mibs"), StdMib = diff --git a/lib/snmp/src/agent/snmpa_trap.erl b/lib/snmp/src/agent/snmpa_trap.erl index 293d1f3ccf..d04b6a206e 100644 --- a/lib/snmp/src/agent/snmpa_trap.erl +++ b/lib/snmp/src/agent/snmpa_trap.erl @@ -917,7 +917,7 @@ do_send_v2_trap(Recvs, Vbs, ExtraInfo, NetIf) -> TrapPdu = make_v2_notif_pdu(Vbs, 'snmpv2-trap'), AddrCommunities = mk_addr_communities(Recvs), lists:foreach(fun({Community, Addrs}) -> - ?vtrace("~n send v2 trap to ~p",[Addrs]), + ?vtrace("send v2 trap to ~p",[Addrs]), NetIf ! {send_pdu, 'version-2', TrapPdu, {community, Community}, Addrs, ExtraInfo} end, AddrCommunities), diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src index d4bf0de61a..178309b488 100644 --- a/lib/snmp/src/app/snmp.app.src +++ b/lib/snmp/src/app/snmp.app.src @@ -49,6 +49,9 @@ snmpa_error_io, snmpa_error_logger, snmpa_error_report, + snmpa_get, + snmpa_get_lib, + snmpa_get_mechanism, snmpa_local_db, snmpa_mib, snmpa_mib_data, diff --git a/lib/snmp/src/app/snmp.config b/lib/snmp/src/app/snmp.config index b66ef5d7df..f35a636157 100644 --- a/lib/snmp/src/app/snmp.config +++ b/lib/snmp/src/app/snmp.config @@ -8,6 +8,7 @@ %% {agent_verbosity, verbosity()} | %% {versions, versions()} | %% {priority, atom()} | +%% {get_mechanism, module()} | %% {set_mechanism, module()} | %% {authentication_service, module()} | %% {multi_threaded, bool()} | diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index 8a736f688b..216452afdd 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. 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. @@ -116,7 +116,10 @@ pdu/0, trappdu/0, mib/0, - mib_name/0, + mib_name/0, + + error_status/0, + error_index/0, void/0 ]). @@ -208,6 +211,23 @@ -type pdu() :: #pdu{}. -type trappdu() :: #trappdu{}. +%% We should really specify all of these, but they are so numerous... +%% See the validate_err/1 function in the snmpa_agent. +%% Here are a number of them: +%% badValue | +%% commitFailed | +%% genErr | +%% inconsistentName | inconsistentValue | +%% noAccess | noCreation | +%% noSuchInstance | noSuchName | noSuchObject | +%% notWritable | +%% resourceUnavailable | +%% undoFailed | +%% wrongValue + +-type error_status() :: atom(). +-type error_index() :: pos_integer(). + -type void() :: term(). 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/modules.mk b/lib/snmp/test/modules.mk index 0f54e67c65..8b6547f9a9 100644 --- a/lib/snmp/test/modules.mk +++ b/lib/snmp/test/modules.mk @@ -31,6 +31,7 @@ SUITE_MODULES = \ snmp_agent_mibs_test \ snmp_agent_nfilter_test \ snmp_agent_test \ + snmp_agent_test_get \ snmp_agent_conf_test \ snmp_agent_test_lib \ snmp_manager_config_test \ 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_get.erl b/lib/snmp/test/snmp_agent_test_get.erl new file mode 100644 index 0000000000..517c71507a --- /dev/null +++ b/lib/snmp/test/snmp_agent_test_get.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-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. +%% 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(snmp_agent_test_get). + +-behaviour(snmpa_get_mechanism). + + +%%%----------------------------------------------------------------- +%%% snmpa_get_mechanism exports +%%%----------------------------------------------------------------- + +-export([ + do_get/3, do_get/4, + do_get_next/3, + do_get_bulk/7 + ]). + + + +do_get(UnsortedVarbinds, IsNotification, Extra) -> + snmpa_get:do_get(UnsortedVarbinds, IsNotification, Extra). + + + +do_get(MibView, UnsortedVarbinds, IsNotification, Extra) -> + snmpa_get:do_get(MibView, UnsortedVarbinds, IsNotification, Extra). + + + +do_get_next(MibView, UnsortedVBs, Extra) -> + snmpa_get:do_get_next(MibView, UnsortedVBs, Extra). + + + + +do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, Extra) -> + snmpa_get:do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, + Extra). diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 66211d7105..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. @@ -445,6 +453,7 @@ start_agent(Config, Vsns, Opts) -> [{versions, Vsns}, {agent_type, master}, {agent_verbosity, trace}, + {get_mechanism, snmp_agent_test_get}, {db_dir, AgentDbDir}, {audit_trail_log, [{type, read_write}, {dir, AgentLogDir}, @@ -463,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) -> @@ -669,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) -> @@ -727,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). @@ -863,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. @@ -898,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}} @@ -923,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()] @@ -942,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()); @@ -969,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) -> @@ -985,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) @@ -1002,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()). @@ -1017,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, @@ -1071,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, @@ -1119,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; @@ -1135,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; @@ -1151,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}}; @@ -1165,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, @@ -1192,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 -> @@ -1214,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)}, @@ -1228,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_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2e48d5134d..a28f925a22 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -226,10 +226,8 @@ agent_capabilities(Config) when is_list(Config) -> put(tname,agent_capabilities), p("starting with Config: ~p~n", [Config]), - SnmpPrivDir = code:priv_dir(snmp), + SnmpPrivDir = which_priv_dir(snmp), SnmpMibsDir = join(SnmpPrivDir, "mibs"), - OtpMibsPrivDir = code:priv_dir(otp_mibs), - OtpMibsMibsDir = join(OtpMibsPrivDir, "mibs"), Dir = ?config(mib_dir, Config), AcMib = join(Dir,"AC-TEST-MIB.mib"), ?line {ok, MibFile1} = snmpc:compile(AcMib, [options, @@ -269,22 +267,20 @@ module_compliance(Config) when is_list(Config) -> put(tname,module_compliance), p("starting with Config: ~p~n", [Config]), - SnmpPrivDir = code:priv_dir(snmp), - SnmpMibsDir = join(SnmpPrivDir, "mibs"), - OtpMibsPrivDir = code:priv_dir(otp_mibs), - OtpMibsMibsDir = join(OtpMibsPrivDir, "mibs"), - Dir = ?config(mib_dir, Config), - AcMib = join(Dir,"MC-TEST-MIB.mib"), + SnmpPrivDir = which_priv_dir(snmp), + SnmpMibsDir = join(SnmpPrivDir, "mibs"), + Dir = ?config(mib_dir, Config), + AcMib = join(Dir,"MC-TEST-MIB.mib"), ?line {ok, MibFile1} = snmpc:compile(AcMib, [options, version, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib1} = snmp_misc:read_mib(MibFile1), ?line {ok, MibFile2} = snmpc:compile(AcMib, [options, version, module_compliance, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib2} = snmp_misc:read_mib(MibFile2), @@ -731,6 +727,15 @@ check_desc(Desc1, Desc2) -> exit({'description not equal', Desc1, Desc2}). +which_priv_dir(App) -> + case code:priv_dir(App) of + Dir when is_list(Dir) -> + Dir; + {error, Reason} -> + exit({App, priv_dir_not_found, Reason}) + end. + + %% join(Comp) -> %% filename:join(Comp). diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 6ced55f0cc..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. @@ -6179,7 +6264,12 @@ start_agent(Node, Vsns, Conf0, _Opts) -> {mib_server, [{verbosity, MSV}]}, {note_store, [{verbosity, NSV}]}, {stymbolic_store, [{verbosity, SSV}]}, - {net_if, [{verbosity, NIV}]}, + {net_if, [{verbosity, NIV}, + %% On some linux "they" add a 127.0.1.1 or somthing + %% similar, so if we don't specify bind_to + %% we don't know which address will be selected + %% (which will cause problems for some test cases). + {options, [{bind_to, true}]}]}, {multi_threaded, true}], ?line ok = set_agent_env(Node, Env), 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..78990c48f2 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,53 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.7.6</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + When an SSH server receives the very first message on a + new TCP connection, and that message is not the expected + one, the 64 first bytes of the received message are now + dumped in the INFO REPORT that reports the Protocol + Error.</p> + <p> + This facilitates the debugging of who sends the bad + message or of detecting a possible port scanning.</p> + <p> + Own Id: OTP-15772</p> + </item> + </list> + </section> + +</section> + +<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 +372,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.app.src b/lib/ssh/src/ssh.app.src index 410061cded..7449405d20 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -44,10 +44,10 @@ {env, []}, {mod, {ssh_app, []}}, {runtime_dependencies, [ - "crypto-4.2", - "erts-6.0", - "kernel-3.0", - "public_key-1.5.2", - "stdlib-3.3" + "crypto-@OTP-15644@", + "erts-9.0", + "kernel-5.3", + "public_key-1.6.1", + "stdlib-3.4.1" ]}]}. 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_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 7c87591cf2..8f32966a12 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -594,7 +594,7 @@ handle_event(_, socket_control, {hello,_}=StateName, D) -> {stop, {shutdown,{unexpected_getopts_return, Other}}} end; -handle_event(_, {info_line,_Line}, {hello,Role}=StateName, D) -> +handle_event(_, {info_line,Line}, {hello,Role}=StateName, D) -> case Role of client -> %% The server may send info lines to the client before the version_exchange @@ -605,9 +605,9 @@ handle_event(_, {info_line,_Line}, {hello,Role}=StateName, D) -> %% But the client may NOT send them to the server. Openssh answers with cleartext, %% and so do we send_bytes("Protocol mismatch.", D), - ?call_disconnectfun_and_log_cond("Protocol mismatch.", - "Protocol mismatch in version exchange. Client sent info lines.", - StateName, D), + Msg = io_lib:format("Protocol mismatch in version exchange. Client sent info lines.~n~s", + [ssh_dbg:hex_dump(Line, 64)]), + ?call_disconnectfun_and_log_cond("Protocol mismatch.", Msg, StateName, D), {stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}} end; diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index 4fe15b24d3..43ac4c0ccf 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -60,6 +60,7 @@ cbuf_stop_clear/0, cbuf_in/1, cbuf_list/0, + hex_dump/1, hex_dump/2, fmt_cbuf_items/0, fmt_cbuf_item/1 ]). @@ -439,3 +440,75 @@ fmt_value(#circ_buf_entry{module = M, io_lib:format("~p:~p ~p/~p ~p~n~s",[M,L,F,A,Pid,fmt_value(V)]); fmt_value(Value) -> io_lib:format("~p",[Value]). + +%%%================================================================ + +-record(h, {max_bytes = 65536, + bytes_per_line = 16, + address_len = 4 + }). + + +hex_dump(Data) -> hex_dump1(Data, hd_opts([])). + +hex_dump(X, Max) when is_integer(Max) -> + hex_dump(X, [{max_bytes,Max}]); +hex_dump(X, OptList) when is_list(OptList) -> + hex_dump1(X, hd_opts(OptList)). + +hex_dump1(B, Opts) when is_binary(B) -> hex_dump1(binary_to_list(B), Opts); +hex_dump1(L, Opts) when is_list(L), length(L) > Opts#h.max_bytes -> + io_lib:format("~s---- skip ~w bytes----~n", [hex_dump1(lists:sublist(L,Opts#h.max_bytes), Opts), + length(L) - Opts#h.max_bytes + ]); +hex_dump1(L, Opts0) when is_list(L) -> + Opts = Opts0#h{address_len = num_hex_digits(Opts0#h.max_bytes)}, + Result = hex_dump(L, [{0,[],[]}], Opts), + [io_lib:format("~*.s | ~*s | ~s~n" + "~*.c-+-~*c-+-~*c~n", + [Opts#h.address_len, lists:sublist("Address",Opts#h.address_len), + -3*Opts#h.bytes_per_line, lists:sublist("Hexdump",3*Opts#h.bytes_per_line), + "ASCII", + Opts#h.address_len, $-, + 3*Opts#h.bytes_per_line, $-, + Opts#h.bytes_per_line, $- + ]) | + [io_lib:format("~*.16.0b | ~s~*c | ~s~n",[Opts#h.address_len, N*Opts#h.bytes_per_line, + lists:reverse(Hexs), + 3*(Opts#h.bytes_per_line-length(Hexs)), $ , + lists:reverse(Chars)]) + || {N,Hexs,Chars} <- lists:reverse(Result) + ] + ]. + + +hd_opts(L) -> lists:foldl(fun hd_opt/2, #h{}, L). + +hd_opt({max_bytes,M}, O) -> O#h{max_bytes=M}; +hd_opt({bytes_per_line,M}, O) -> O#h{bytes_per_line=M}. + + +num_hex_digits(N) when N<16 -> 1; +num_hex_digits(N) -> trunc(math:ceil(math:log2(N)/4)). + + +hex_dump([L|Cs], Result0, Opts) when is_list(L) -> + Result = hex_dump(L,Result0, Opts), + hex_dump(Cs, Result, Opts); + +hex_dump(Cs, [{N0,_,Chars}|_]=Lines, Opts) when length(Chars) == Opts#h.bytes_per_line -> + hex_dump(Cs, [{N0+1,[],[]}|Lines], Opts); + +hex_dump([C|Cs], [{N,Hexs,Chars}|Lines], Opts) -> + Asc = if + 16#20 =< C,C =< 16#7E -> C; + true -> $. + end, + Hex = io_lib:format("~2.16.0b ", [C]), + hex_dump(Cs, [{N, [Hex|Hexs], [Asc|Chars]} | Lines], Opts); + +hex_dump([], Result, _) -> + Result. + + + 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 1f4e281a30..eaab13433a 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -170,7 +170,7 @@ supported_algorithms(cipher) -> {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]}, {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, {'aes128-cbc', [{ciphers,aes_128_cbc}]}, - {'3des-cbc', [{ciphers,des3_cbc}]} + {'3des-cbc', [{ciphers,des_ede3_cbc}]} ] )); supported_algorithms(mac) -> @@ -1328,25 +1328,27 @@ 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}; cipher('3des-cbc') -> - #cipher{impl = des3_cbc, + #cipher{impl = des_ede3_cbc, key_bytes = 24, iv_bytes = 8, 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 @@ -1445,30 +1451,31 @@ encrypt(#ssh{encrypt = '[email protected]', <<LenData:4/binary, PayloadData/binary>>) -> %% Encrypt length IV1 = <<0:8/unit:8, Seq:8/unit:8>>, - EncLen = crypto:crypto_one_shot(chacha20, K1, IV1, LenData, true), + EncLen = crypto:crypto_one_time(chacha20, K1, IV1, LenData, true), %% Encrypt payload IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - EncPayloadData = crypto:crypto_one_shot(chacha20, K2, IV2, PayloadData, true), + EncPayloadData = crypto:crypto_one_time(chacha20, K2, IV2, PayloadData, true), %% MAC tag - PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), + PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), EncBytes = <<EncLen/binary,EncPayloadData/binary>>, Ctag = crypto:poly1305(PolyKey, EncBytes), %% Result {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_shot(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_shot(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_shot(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..837da27ab0 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.6 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index a511cb4db3..7947049a04 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,57 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Missing check of size of user_data_buffer made internal + socket behave as an active socket instead of active N. + This could cause memory problems.</p> + <p> + Own Id: OTP-15802 Aux Id: ERL-934 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Back port of bug fix ERL-893 from OTP-22 and document + enhancements that will solve dialyzer warnings for users + of the ssl application.</p> + <p> + This change also affects public_key, eldap (and inet + doc).</p> + <p> + Own Id: OTP-15785 Aux Id: ERL-929, ERL-893, PR-2215 </p> + </item> + </list> + </section> + +</section> + +<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/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 74a0a0a03e..3aa6e09c2c 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -128,7 +128,7 @@ <name name="hostname"/> </datatype> - <datatype> + <datatype> <name name="ip_address"/> </datatype> @@ -136,14 +136,14 @@ <name name="protocol_version"/> </datatype> - <datatype> + <datatype> <name name="tls_version"/> </datatype> - + <datatype> <name name="dtls_version"/> </datatype> - + <datatype> <name name="tls_legacy_version"/> </datatype> @@ -151,9 +151,8 @@ <datatype> <name name="dtls_legacy_version"/> </datatype> - - - <datatype> + + <datatype> <name name="prf_random"/> </datatype> @@ -218,10 +217,6 @@ </datatype> <datatype> - <name name="eccs"/> - </datatype> - - <datatype> <name name="named_curve"/> </datatype> @@ -253,6 +248,10 @@ <name name="tls_alert"/> </datatype> + <datatype> + <name name="reason"/> + </datatype> + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</datatype_title> <datatype> @@ -343,13 +342,6 @@ </datatype> <datatype> - <name name="eccs"/> - <desc><p> Allows to specify the order of preference for named curves - and to restrict their usage when using a cipher suite supporting them.</p> - </desc> - </datatype> - - <datatype> <name name="signature_schemes"/> <desc> <p> @@ -1109,13 +1101,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <funcs> <func> - <name since="OTP 20.3">append_cipher_suites(Deferred, Suites) -> ciphers() </name> + <name name="append_cipher_suites" arity="2" since="OTP 20.3"/> <fsummary></fsummary> - <type> - <v>Deferred = <seealso marker="#type-ciphers">ciphers()</seealso> | - <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> - <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> - </type> <desc><p>Make <c>Deferred</c> suites become the least preferred suites, that is put them at the end of the cipher suite list <c>Suites</c> after removing them from <c>Suites</c> if @@ -1126,25 +1113,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">cipher_suites() -></name> - <name since="OTP R14B">cipher_suites(Type) -> [old_cipher_suite()]</name> + <name name="cipher_suites" arity="0" since="OTP R14B"/> + <name name="cipher_suites" arity="1" since="OTP R14B"/> <fsummary>Returns a list of supported cipher suites.</fsummary> - <type> - <v>Type = erlang | openssl | all</v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#cipher_suites-2">cipher_suites/2</seealso> instead.</p> </desc> </func> <func> - <name since="OTP 20.3">cipher_suites(Supported, Version) -> ciphers()</name> + <name name="cipher_suites" arity="2" since="OTP 20.3"/> <fsummary>Returns a list of all default or all supported cipher suites.</fsummary> - <type> - <v> Supported = default | all | anonymous </v> - <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> - </type> <desc><p>Returns all default or all supported (except anonymous), or all anonymous cipher suites for a TLS version</p> @@ -1152,16 +1132,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 19.2">eccs() -></name> - <name since="OTP 19.2">eccs(Version) -> NamedCurves</name> + <name name="cipher_suites" arity="3" since="OTP 22.0"/> + <fsummary>Returns a list of RFC or OpenSSL names</fsummary> + <desc><p>Same as <seealso marker="#cipher_suites-2">cipher_suites/2</seealso> + but lists RFC or OpenSSL string names instead of <seealso marker="#type-erl_cipher_suite">erl_cipher_suite()</seealso> + </p> + </desc> + </func> + + <func> + <name name="eccs" arity="0" since="OTP 19.2"/> + <name name="eccs" arity="1" since="OTP 19.2"/> <fsummary>Returns a list of supported ECCs.</fsummary> - - <type> - <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> - <v> NamedCurves = <seealso marker="#type-named_curve">[named_curve()] </seealso></v> - - </type> - <desc><p>Returns a list of supported ECCs. <c>eccs()</c> is equivalent to calling <c>eccs(Protocol)</c> with all supported protocols and then deduplicating the output.</p> @@ -1169,9 +1151,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 17.5">clear_pem_cache() -> ok </name> + <name name="clear_pem_cache" arity="0" since="OTP 17.5"/> <fsummary> Clears the pem cache</fsummary> - <desc><p>PEM files, used by ssl API-functions, are cached. The cache is regularly checked to see if any cache entries should be invalidated, however this function provides a way to @@ -1181,19 +1162,10 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">connect(Socket, Options) -> </name> - <name since="">connect(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} - | {error, Reason}</name> + <name name="connect" arity="2" since="OTP R14B"/> + <name name="connect" arity="3" clause_i="1" since=""/> <fsummary>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket.</fsummary> - <type> - <v>Socket = <seealso marker="#type-socket"> socket() </seealso></v> - <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()] </seealso></v> - <v>Timeout = timeout()</v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket, that is, performs the client-side TLS handshake.</p> @@ -1225,18 +1197,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">connect(Host, Port, Options) -></name> - <name since="">connect(Host, Port, Options, Timeout) -> - {ok, SslSocket}| {ok, SslSocket, Ext} | {error, Reason}</name> + <name since="" name="connect" arity="3" clause_i="2"/> + <name since="" name="connect" arity="4"/> <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary> - <type> - <v>Host =<seealso marker="#type-host"> host() </seealso> </v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()]</seealso></v> - <v>Timeout = timeout()</v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p> <p> When the option <c>verify</c> is set to <c>verify_peer</c> the check @@ -1273,24 +1236,15 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">close(SslSocket) -> ok | {error, Reason}</name> + <name since="" name="close" arity="1" /> <fsummary>Closes an TLS/DTLS connection.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Reason = term()</v> - </type> <desc><p>Closes an TLS/DTLS connection.</p> </desc> </func> <func> - <name since="OTP 18.1">close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name> + <name since="OTP 18.1" name="close" arity="2"/> <fsummary>Closes an TLS connection.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>How = timeout() | {NewController::pid(), timeout()} </v> - <v>Reason = term()</v> - </type> <desc><p>Closes or downgrades an TLS connection. In the latter case the transport connection will be handed over to the <c>NewController</c> process after receiving the TLS close alert from the peer. The returned transport socket will have @@ -1299,15 +1253,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">controlling_process(SslSocket, NewOwner) -> - ok | {error, Reason}</name> + <name since="" name="controlling_process" arity="2" /> <fsummary>Assigns a new controlling process to the TLS/DTLS socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>NewOwner = pid()</v> - <v>Reason = term()</v> - </type> <desc><p>Assigns a new controlling process to the SSL socket. A controlling process is the owner of an SSL socket, and receives all messages from the socket.</p> @@ -1315,17 +1263,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 18.0">connection_information(SslSocket) -> - {ok, Result} | {error, Reason} </name> + <name since="OTP 18.0" name="connection_information" arity="1"/> <fsummary>Returns all the connection information. </fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Item = protocol | selected_cipher_suite | sni_hostname | ecc | session_id | atom()</v> - <d>Meaningful atoms, not specified above, are the ssl option names.</d> - <v>Result = [{Item::atom(), Value::term()}]</v> - <v>Reason = term()</v> - </type> <desc><p>Returns the most relevant information about the connection, ssl options that are undefined will be filtered out. Note that values that affect the security of the connection will only be returned if explicitly requested by connection_information/2.</p> @@ -1336,34 +1276,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 18.0">connection_information(SslSocket, Items) -> - {ok, Result} | {error, Reason} </name> + <name since="OTP 18.0" name="connection_information" arity="2"/> <fsummary>Returns the requested connection information. </fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Items = [Item]</v> - <v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | client_random - | server_random | master_secret | atom()</v> - <d>Note that client_random, server_random and master_secret are values - that affect the security of connection. Meaningful atoms, not specified above, are the ssl option names.</d> - <v>Result = [{Item::atom(), Value::term()}]</v> - <v>Reason = term()</v> - </type> <desc><p>Returns the requested information items about the connection, if they are defined.</p> + <p>Note that client_random, server_random and master_secret are values + that affect the security of connection. Meaningful atoms, not specified + above, are the ssl option names.</p> + <note><p>If only undefined options are requested the resulting list can be empty.</p></note> </desc> </func> <func> - <name since="OTP 20.3">filter_cipher_suites(Suites, Filters) -> ciphers()</name> + <name since="OTP 20.3" name="filter_cipher_suites" arity="2" /> <fsummary></fsummary> - <type> - <v> Suites = <seealso marker="#type-ciphers"> ciphers() </seealso></v> - <v> Filters = <seealso marker="#type-cipher_filters"> cipher_filters() </seealso></v> - </type> <desc><p>Removes cipher suites if any of the filter functions returns false for any part of the cipher suite. This function also calls default filter functions to make sure the cipher @@ -1373,24 +1302,16 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">format_error(Reason) -> string()</name> + <name since="" name="format_error" arity="1" /> <fsummary>Returns an error string.</fsummary> - <type> - <v>Reason = term()</v> - </type> <desc> <p>Presents the error returned by an SSL function as a printable string.</p> </desc> </func> <func> - <name since="">getopts(SslSocket, OptionNames) -> - {ok, [socketoption()]} | {error, Reason}</name> + <name since="" name="getopts" arity="2" /> <fsummary>Gets the values of the specified options.</fsummary> - <type> - <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>OptionNames = [atom()]</v> - </type> <desc> <p>Gets the values of the specified socket options. </p> @@ -1398,16 +1319,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 19.0">getstat(SslSocket) -> - {ok, OptionValues} | {error, inet:posix()}</name> - <name since="OTP 19.0">getstat(SslSocket, OptionNames) -> - {ok, OptionValues} | {error, inet:posix()}</name> + <name since="OTP 19.0" name="getstat" arity="1" /> + <name since="OTP 19.0" name="getstat" arity="2" /> <fsummary>Get one or more statistic options for a socket</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>OptionNames = [atom()]</v> - <v>OptionValues = [{inet:stat_option(), integer()}]</v> - </type> <desc> <p>Gets one or more statistic options for the underlying TCP socket.</p> <p>See inet:getstat/2 for statistic options description.</p> @@ -1415,14 +1329,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake(HsSocket) -> </name> - <name since="OTP 21.0">handshake(HsSocket, Timeout) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake" arity="1" /> + <name since="OTP 21.0" name="handshake" arity="2" clause_i="1" /> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> - <type> - <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Performs the SSL/TLS/DTLS server-side handshake.</p> <p>Returns a new TLS/DTLS socket if the handshake is successful.</p> @@ -1435,17 +1344,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake(Socket, Options) -> </name> - <name since="OTP 21.0">handshake(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake" arity="2" clause_i="2" /> + <name since="OTP 21.0" name="handshake" arity="3" /> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> - <type> - <v>Socket = socket() | <seealso marker="#type-sslsocket"> socket() </seealso> </v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>, or equivalent, socket to an SSL socket, that is, performs @@ -1481,52 +1382,33 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake_cancel(SslSocket) -> ok </name> + <name since="OTP 21.0" name="handshake_cancel" arity="1" /> <fsummary>Cancel handshake with a fatal alert</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc> <p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p> </desc> </func> <func> - <name since="OTP 21.0">handshake_continue(HsSocket, Options) -> {ok, SslSocket} | {error, Reason}</name> - <name since="OTP 21.0">handshake_continue(HsSocket, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake_continue" arity="2" /> + <name since="OTP 21.0" name="handshake_continue" arity="3" /> <fsummary>Continue the SSL/TLS handshake.</fsummary> - <type> - <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Options = <seealso marker="#type-tls_option"> tls_option() </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p> </desc> </func> <func> - <name since="">listen(Port, Options) -> - {ok, ListenSocket} | {error, Reason}</name> + <name since="" name="listen" arity="2" /> <fsummary>Creates an SSL listen socket.</fsummary> - <type> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso></v> - <v>ListenSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc> <p>Creates an SSL listen socket.</p> </desc> </func> <func> - <name since="OTP 18.0">negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name> + <name since="OTP 18.0" name="negotiated_protocol" arity="1" /> <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Protocol = binary()</v> - </type> <desc> <p> Returns the protocol negotiated through ALPN or NPN extensions. @@ -1535,12 +1417,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">peercert(SslSocket) -> {ok, Cert} | {error, Reason}</name> + <name since="" name="peercert" arity="1" /> <fsummary>Returns the peer certificate.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Cert = binary()</v> - </type> <desc> <p>The peer certificate is returned as a DER-encoded binary. The certificate can be decoded with @@ -1550,27 +1428,16 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">peername(SslSocket) -> {ok, {Address, Port}} | - {error, Reason}</name> + <name since="" name="peername" arity="1" /> <fsummary>Returns the peer address and port.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Address = ipaddress()</v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - </type> <desc> <p>Returns the address and port number of the peer.</p> </desc> </func> <func> - <name since="OTP 20.3">prepend_cipher_suites(Preferred, Suites) -> ciphers()</name> + <name since="OTP 20.3" name="prepend_cipher_suites" arity="2" /> <fsummary></fsummary> - <type> - <v>Preferred = <seealso marker="#type-ciphers">ciphers()</seealso> | - <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> - <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> - </type> <desc><p>Make <c>Preferred</c> suites become the most preferred suites that is put them at the head of the cipher suite list <c>Suites</c> after removing them from <c>Suites</c> if @@ -1581,15 +1448,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R15B01">prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> + <name since="OTP R15B01" name="prf" arity="5" /> <fsummary>Uses a session Pseudo-Random Function to generate key material.</fsummary> - <type> - <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Secret = binary() | master_secret</v> - <v>Label = binary()</v> - <v>Seed = [binary() | <seealso marker="#type-prf_random"> prf_random()</seealso>]</v> - <v>WantedLength = non_neg_integer()</v> - </type> <desc> <p>Uses the Pseudo-Random Function (PRF) of a TLS session to generate extra key material. It either takes user-generated values for @@ -1601,16 +1461,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">recv(SslSocket, Length) -> </name> - <name since="">recv(SslSocket, Length, Timeout) -> {ok, Data} | {error, - Reason}</name> + <name since="" name="recv" arity="2" /> + <name since="" name="recv" arity="3" /> <fsummary>Receives data on a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Length = integer()</v> - <v>Timeout = timeout()</v> - <v>Data = [char()] | binary()</v> - </type> + <type_desc variable="HttpPacket">See the description of + <c>HttpPacket</c> in + <seealso marker="erts:erlang#decode_packet/3"><c>erlang:decode_packet/3</c></seealso> + in ERTS. + </type_desc> <desc> <p>Receives a packet from a socket in passive mode. A closed socket is indicated by return value @@ -1628,11 +1486,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">renegotiate(SslSocket) -> ok | {error, Reason}</name> + <name since="OTP R14B" name="renegotiate" arity="1" /> <fsummary>Initiates a new handshake.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc><p>Initiates a new handshake. A notable return value is <c>{error, renegotiation_rejected}</c> indicating that the peer refused to go through with the renegotiation, but the connection @@ -1641,40 +1496,27 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">send(SslSocket, Data) -> ok | {error, Reason}</name> + <name since="" name="send" arity="2" /> <fsummary>Writes data to a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Data = iodata()</v> - </type> <desc> - <p>Writes <c>Data</c> to <c>Socket</c>.</p> + <p>Writes <c>Data</c> to <c>SslSocket</c>.</p> <p>A notable return value is <c>{error, closed}</c> indicating that the socket is closed.</p> </desc> </func> <func> - <name since="">setopts(SslSocket, Options) -> ok | {error, Reason}</name> + <name since="" name="setopts" arity="2" /> <fsummary>Sets socket options.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Options = <seealso marker="#type-socket_option"> [socket_option()] </seealso></v> - </type> <desc> <p>Sets options according to <c>Options</c> for socket - <c>Socket</c>.</p> + <c>SslSocket</c>.</p> </desc> </func> <func> - <name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name> + <name since="OTP R14B" name="shutdown" arity="2" /> <fsummary>Immediately closes a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>How = read | write | read_write</v> - <v>Reason = reason()</v> - </type> <desc> <p>Immediately closes a socket in one or two directions.</p> <p><c>How == write</c> means closing the socket for writing, @@ -1686,14 +1528,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">ssl_accept(SslSocket) -> </name> - <name since="">ssl_accept(SslSocket, Timeout) -> ok | {error, Reason}</name> + <name since="" name="ssl_accept" arity="1" /> + <name since="" name="ssl_accept" arity="2" /> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-1">handshake/[1,2]</seealso> instead.</p> <note><p>handshake/[1,2] always returns a new socket.</p></note> @@ -1701,15 +1538,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">ssl_accept(Socket, Options) -> </name> - <name since="OTP R14B">ssl_accept(Socket, Options, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> + <name since="OTP R14B" name="ssl_accept" arity="3" /> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> - <type> - <v>Socket = socket() | <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-3">handshake/[2,3]</seealso> instead.</p> <note><p>handshake/[2,3] always returns a new socket.</p></note> @@ -1717,27 +1547,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">sockname(SslSocket) -> {ok, {Address, Port}} | - {error, Reason}</name> + <name since="" name="sockname" arity="1" /> <fsummary>Returns the local address and port.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Address = <seealso marker="#type-ip_address">ip_address()</seealso></v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - </type> <desc> <p>Returns the local address and port number of socket - <c>Socket</c>.</p> + <c>SslSocket</c>.</p> </desc> </func> <func> - <name since="OTP R14B">start() -> </name> + <name since="OTP R14B" name="start" arity="0" /> <name since="OTP R14B">start(Type) -> ok | {error, Reason}</name> <fsummary>Starts the SSL application.</fsummary> - <type> - <v>Type = permanent | transient | temporary</v> - </type> <desc> <p>Starts the SSL application. Default type is <c>temporary</c>.</p> @@ -1745,36 +1566,50 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">stop() -> ok </name> + <name since="OTP R14B" name="stop" arity="0" /> <fsummary>Stops the SSL application.</fsummary> <desc> <p>Stops the SSL application.</p> </desc> </func> + + <func> + <name since="OTP 22.0" name="str_to_suite" arity="1" /> + <fsummary>Converts an RFC or OpenSSL name string to an erlang cipher suite format</fsummary> + <desc> + <p>Converts an RFC or OpenSSL name string to an + <seealso marker="#type-erl_cipher_suite">erl_cipher_suite()</seealso> + Returns an error if the cipher suite is not supported or the name is not a valid cipher suite name.</p> + </desc> + </func> <func> - <name since="OTP 21.0">suite_to_str(CipherSuite) -> String</name> - <fsummary>Returns the string representation of a cipher suite.</fsummary> - <type> - <v>CipherSuite = <seealso marker="#type-erl_cipher_suite"> erl_cipher_suite() </seealso></v> - <v>String = string()</v> - </type> + <name since="OTP 22.0" name="suite_to_openssl_str" arity="1" /> + <fsummary>Converts erlang cipher suite format to an OpenSSL name string. + </fsummary> + <desc> + <p>Converts <seealso marker="#type-erl_cipher_suite">erl_cipher_suite()</seealso> + to OpenSSL name string. </p> + + <p>PRE TLS-1.3 these names differ for RFC names</p> + + </desc> + </func> + + <func> + <name since="OTP 21.0" name="suite_to_str" arity="1" clause_i="1" /> + <fsummary>Converts an erlang cipher suite to an RFC name string.</fsummary> <desc> - <p>Returns the string representation of a cipher suite.</p> + <p>Converts <seealso marker="#type-erl_cipher_suite">erl_cipher_suite()</seealso> + to RFC name string.</p> </desc> </func> <func> - <name since="">transport_accept(ListenSocket) -></name> - <name since="">transport_accept(ListenSocket, Timeout) -> - {ok, SslSocket} | {error, Reason}</name> + <name since="" name="transport_accept" arity="1" /> + <name since="" name="transport_accept" arity="2" /> <fsummary>Accepts an incoming connection and prepares for <c>ssl_accept</c>.</fsummary> - <type> - <v>ListenSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = reason()</v> - </type> <desc> <p>Accepts an incoming connection request on a listen socket. <c>ListenSocket</c> must be a socket returned from @@ -1800,13 +1635,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">versions() -> [versions_info()]</name> + <name since="OTP R14B" name="versions" arity="0" /> <fsummary>Returns version information relevant for the SSL application.</fsummary> - <type> - <v>versions_info() = {app_vsn, string()} | {supported | available, [ssl_tls_protocol()]} | - {supported_dtls | available_dtls, [dtls_protocol()]} </v> - </type> <desc> <p>Returns version information relevant for the SSL application.</p> diff --git a/lib/ssl/doc/src/standards_compliance.xml b/lib/ssl/doc/src/standards_compliance.xml index c20bab4e50..ca98385f85 100644 --- a/lib/ssl/doc/src/standards_compliance.xml +++ b/lib/ssl/doc/src/standards_compliance.xml @@ -126,8 +126,34 @@ <section> <title>TLS 1.3</title> - <p> This section describes the current state of standards compliance for TLS 1.3.</p> - <p>(C = Compliant, NC = Non-Compliant, P = Partially-Compliant, NA = Not Applicable)</p> + <p>OTP-22 introduces basic support for TLS 1.3 on the server side. Basic functionality + covers a simple TLS 1.3 handshake with support of the mandatory extensions + (supported_groups, signature_algorithms, key_share, supported_versions and + signature_algorithms_cert). The server supports a selective set of cryptographic algorithms:</p> + <list type="bulleted"> + <item>Key Exchange: ECDHE</item> + <item>Groups: all standard groups supported for the Diffie-Hellman key exchange</item> + <item>Ciphers: TLS_AES_128_GCM_SHA256, TLS_AES_256_GCM_SHA384, + TLS_CHACHA20_POLY1305_SHA256 and TLS_AES_128_CCM_SHA256</item> + <item>Signature Algorithms: RSA and RSA PSS</item> + <item>Certificates: currently only certificates with RSA keys are supported</item> + </list> + <p>Other notable features:</p> + <list type="bulleted"> + <item>The server supports the HelloRetryRequest mechanism</item> + <item>PSK and session resumption not supported</item> + <item>Early data and 0-RTT not supported</item> + <item>Key and Initialization Vector Update not supported</item> + </list> + <p>For more detailed information see the + <seealso marker="#soc_table">Standards Compliance</seealso> below.</p> + <warning><p>Note that the client side is not yet functional. It is planned to be released + later in OTP-22.</p></warning> + + <p> The following table describes the current state of standards compliance for TLS 1.3.</p> + <p>(<em>C</em> = Compliant, <em>NC</em> = Non-Compliant, <em>PC</em> = Partially-Compliant, + <em>NA</em> = Not Applicable)</p> + <marker id="soc_table"/> <table> <row> <cell align="left" valign="middle"><em>Section</em></cell> @@ -155,7 +181,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">RSASSA-PSS signature schemes</cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle">22</cell> </row> <row> @@ -178,7 +204,7 @@ </url> </cell> <cell align="left" valign="middle"></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -240,7 +266,7 @@ </url> </cell> <cell align="left" valign="middle"></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -783,7 +809,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1265,7 +1291,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1379,7 +1405,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1456,7 +1482,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1527,7 +1553,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em></em></cell> </row> <row> @@ -1762,7 +1788,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1924,7 +1950,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1942,14 +1968,14 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">SHOULD implement the TLS_CHACHA20_POLY1305_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Digital signatures</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1997,7 +2023,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2108,7 +2134,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>TLS 1.3 ServerHello</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2160,7 +2186,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2178,14 +2204,14 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">TLS_CHACHA20_POLY1305_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">TLS_AES_128_CCM_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> @@ -2223,7 +2249,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> @@ -2289,7 +2315,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 7993be8a74..e070006900 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -67,7 +67,7 @@ %% Setup %%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _, _, _, _} = CbInfo, Timeout) -> try {ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket, @@ -147,13 +147,16 @@ next_record(#state{static_env = #static_env{role = server, socket = {Listener, {Client, _}}}} = State) -> dtls_packet_demux:active_once(Listener, Client, self()), {no_record, State}; -next_record(#state{static_env = #static_env{role = client, +next_record(#state{protocol_specific = #{active_n_toggle := true, + active_n := N} = ProtocolSpec, + static_env = #static_env{role = client, socket = {_Server, Socket} = DTLSSocket, close_tag = CloseTag, transport_cb = Transport}} = State) -> - case dtls_socket:setopts(Transport, Socket, [{active,once}]) of + case dtls_socket:setopts(Transport, Socket, [{active,N}]) of ok -> - {no_record, State}; + {no_record, State#state{protocol_specific = + ProtocolSpec#{active_n_toggle => false}}}; _ -> self() ! {CloseTag, DTLSSocket}, {no_record, State} @@ -291,9 +294,10 @@ handle_protocol_record(#ssl_tls{type = _Unknown}, StateName, State) -> %% Handshake handling %%==================================================================== -renegotiate(#state{static_env = #static_env{role = client}} = State, Actions) -> +renegotiate(#state{static_env = #static_env{role = client}} = State0, Actions) -> %% Handle same way as if server requested %% the renegotiation + State = reinit_handshake_data(State0), {next_state, connection, State, [{next_event, internal, #hello_request{}} | Actions]}; @@ -451,8 +455,7 @@ init({call, From}, {start, Timeout}, session = Session0#session{session_id = Hello#client_hello.session_id}, start_or_recv_from = From}, - {Record, State} = next_record(State3), - next_event(hello, Record, State, [{{timeout, handshake}, Timeout, close} | Actions]); + next_event(hello, no_record, State3, [{{timeout, handshake}, Timeout, close} | Actions]); init({call, _} = Type, Event, #state{static_env = #static_env{role = server}, protocol_specific = PS} = State) -> Result = gen_handshake(?FUNCTION_NAME, Type, Event, @@ -510,9 +513,8 @@ hello(internal, #client_hello{cookie = <<>>, %% negotiated. VerifyRequest = dtls_handshake:hello_verify_request(Cookie, ?HELLO_VERIFY_REQUEST_VERSION), State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}), - {State2, Actions} = send_handshake(VerifyRequest, State1), - {Record, State} = next_record(State2), - next_event(?FUNCTION_NAME, Record, + {State, Actions} = send_handshake(VerifyRequest, State1), + next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{ tls_handshake_history = ssl_handshake:init_handshake_history()}}, @@ -714,12 +716,10 @@ connection(internal, #hello_request{}, #state{static_env = #static_env{host = Ho HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions), State1 = prepare_flight(State0), {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}), - {Record, State} = - next_record( - State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, - session = Session0#session{session_id - = Hello#client_hello.session_id}}), - next_event(hello, Record, State, Actions); + State = State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, + session = Session0#session{session_id + = Hello#client_hello.session_id}}, + next_event(hello, no_record, State, Actions); connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{allow_renegotiate = true} = HsEnv} = State) -> %% Mitigate Computational DoS attack @@ -775,7 +775,7 @@ format_status(Type, Data) -> %%% Internal functions %%-------------------------------------------------------------------- initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, - {CbModule, DataTag, CloseTag, ErrorTag}) -> + {CbModule, DataTag, CloseTag, ErrorTag, PassiveTag}) -> #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, ConnectionStates = dtls_record:init_connection_states(Role, BeastMitigation), @@ -785,7 +785,12 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, _ -> ssl_session_cache end, - + InternalActiveN = case application:get_env(ssl, internal_active_n) of + {ok, N} when is_integer(N) -> + N; + _ -> + ?INTERNAL_ACTIVE_N + end, Monitor = erlang:monitor(process, User), InitStatEnv = #static_env{ role = Role, @@ -794,6 +799,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, data_tag = DataTag, close_tag = CloseTag, error_tag = ErrorTag, + passive_tag = PassiveTag, host = Host, port = Port, socket = Socket, @@ -817,7 +823,9 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, user_data_buffer = {[],0,[]}, start_or_recv_from = undefined, flight_buffer = new_flight(), - protocol_specific = #{flight_state => initial_flight_state(DataTag)} + protocol_specific = #{active_n => InternalActiveN, + active_n_toggle => true, + flight_state => initial_flight_state(DataTag)} }. initial_flight_state(udp)-> @@ -914,12 +922,21 @@ handle_info({Protocol, _, _, _, Data}, StateName, ssl_connection:handle_normal_shutdown(Alert, StateName, State0), {stop, {shutdown, own_alert}, State0} end; + +handle_info({PassiveTag, Socket}, StateName, + #state{static_env = #static_env{socket = {_, Socket}, + passive_tag = PassiveTag}, + protocol_specific = PS} = State) -> + next_event(StateName, no_record, + State#state{protocol_specific = PS#{active_n_toggle => true}}); + handle_info({CloseTag, Socket}, StateName, #state{static_env = #static_env{socket = Socket, close_tag = CloseTag}, connection_env = #connection_env{negotiated_version = Version}, socket_options = #socket_options{active = Active}, - protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}} = State) -> + protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}, + protocol_specific = PS} = State) -> %% Note that as of DTLS 1.2 (TLS 1.1), %% failure to properly close a connection no longer requires that a %% session not be resumed. This is a change from DTLS 1.0 to conform @@ -942,7 +959,8 @@ handle_info({CloseTag, Socket}, StateName, %% Fixes non-delivery of final DTLS record in {active, once}. %% Basically allows the application the opportunity to set {active, once} again %% and then receive the final message. - next_event(StateName, no_record, State) + next_event(StateName, no_record, State#state{ + protocol_specific = PS#{active_n_toggle => true}}) end; handle_info(new_cookie_secret, StateName, diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 46e8348ce0..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 -> @@ -427,74 +427,135 @@ merge_fragment(Frag0, [Frag1 | Rest]) -> Frag -> merge_fragment(Frag, Rest) end. -%% Duplicate + + +%% Duplicate (fully contained fragment) +%% 2,5 _ _ P P P P P +%% 2,5 _ _ C C C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, + fragment_offset = PreviousOffSet, fragment_length = PreviousLen, fragment = PreviousData - } = Previous, + } = Previous, #handshake_fragment{ fragment_offset = PreviousOffSet, fragment_length = PreviousLen, fragment = PreviousData}) -> Previous; -%% Lager fragment save new data +%% Duplicate (fully contained fragment) +%% 2,5 _ _ P P P P P +%% 2,2 _ _ C C +%% 0,3 X X X +%% 5,3 _ _ _ _ _ X X X merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen}) + when PreviousOffset =< CurrentOffset andalso + CurrentOffset =< PreviousOffset + PreviousLen andalso + CurrentOffset + CurrentLen =< PreviousOffset + PreviousLen -> + Previous; + +%% Fully overlapping fragments +%% 2,5 _ _ P P P P P +%% 0,8 C C C C C C C C +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffset, + fragment_length = PreviousLen + }, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen} = Current) + when CurrentOffset =< PreviousOffset andalso + CurrentOffset + CurrentLen >= PreviousOffset + PreviousLen -> + Current; + +%% Overlapping fragments +%% 2,5 _ _ P P P P P +%% 0,3 C C C +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, fragment = PreviousData - } = Previous, - #handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = CurrentLen, - fragment = CurrentData}) when CurrentLen > PreviousLen -> - NewLength = CurrentLen - PreviousLen, - <<_:PreviousLen/binary, NewData/binary>> = CurrentData, + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset < PreviousOffset andalso + CurrentOffset + CurrentLen < PreviousOffset + PreviousLen -> + NewDataLen = PreviousOffset - CurrentOffset, + <<NewData:NewDataLen/binary, _/binary>> = CurrentData, Previous#handshake_fragment{ - fragment_length = PreviousLen + NewLength, - fragment = <<PreviousData/binary, NewData/binary>> + fragment_length = PreviousLen + NewDataLen, + fragment = <<NewData/binary, PreviousData/binary>> }; -%% Smaller fragment +%% Overlapping fragments +%% 2,5 _ _ P P P P P +%% 5,3 _ _ _ _ _ C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen - } = Previous, - #handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = CurrentLen}) when CurrentLen < PreviousLen -> - Previous; -%% Next fragment, might be overlapping + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset > PreviousOffset andalso + CurrentOffset < PreviousOffset + PreviousLen -> + NewDataLen = CurrentOffset + CurrentLen - (PreviousOffset + PreviousLen), + DropLen = CurrentLen - NewDataLen, + <<_:DropLen/binary, NewData/binary>> = CurrentData, + Previous#handshake_fragment{ + fragment_length = PreviousLen + NewDataLen, + fragment = <<PreviousData/binary, NewData/binary>> + }; + +%% Adjacent fragments +%% 2,5 _ _ P P P P P +%% 7,3 _ _ _ _ _ _ _ C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, fragment = PreviousData - } = Previous, - #handshake_fragment{ - fragment_offset = CurrentOffSet, - fragment_length = CurrentLen, - fragment = CurrentData}) - when PreviousOffSet + PreviousLen >= CurrentOffSet andalso - PreviousOffSet + PreviousLen < CurrentOffSet + CurrentLen -> - CurrentStart = PreviousOffSet + PreviousLen - CurrentOffSet, - <<_:CurrentStart/bytes, Data/binary>> = CurrentData, + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset =:= PreviousOffset + PreviousLen -> Previous#handshake_fragment{ - fragment_length = PreviousLen + CurrentLen - CurrentStart, - fragment = <<PreviousData/binary, Data/binary>>}; -%% already fully contained fragment + fragment_length = PreviousLen + CurrentLen, + fragment = <<PreviousData/binary, CurrentData/binary>> + }; + +%% Adjacent fragments +%% 2,5 _ _ P P P P P +%% 0,2 C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen - } = Previous, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, #handshake_fragment{ - fragment_offset = CurrentOffSet, - fragment_length = CurrentLen}) - when PreviousOffSet + PreviousLen >= CurrentOffSet andalso - PreviousOffSet + PreviousLen >= CurrentOffSet + CurrentLen -> - Previous; + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when PreviousOffset =:= CurrentOffset + CurrentLen -> + Previous#handshake_fragment{ + fragment_length = PreviousLen + CurrentLen, + fragment = <<CurrentData/binary, PreviousData/binary>> + }; %% No merge there is a gap +%% 3,5 _ _ _ P P P P +%% 0,2 C C merge_fragments(Previous, Current) -> [Previous, Current]. diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl index 2e9184b7ac..c6431b55a9 100644 --- a/lib/ssl/src/dtls_packet_demux.erl +++ b/lib/ssl/src/dtls_packet_demux.erl @@ -35,7 +35,8 @@ terminate/2, code_change/3]). -record(state, - {port, + {active_n, + port, listener, transport, dtls_options, @@ -76,10 +77,18 @@ set_sock_opts(PacketSocket, Opts) -> %%% gen_server callbacks %%%=================================================================== -init([Port, {TransportModule, _,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> +init([Port, {TransportModule, _,_,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> try {ok, Socket} = TransportModule:open(Port, InetOptions), - {ok, #state{port = Port, + InternalActiveN = case application:get_env(ssl, internal_active_n) of + {ok, N} when is_integer(N) -> + N; + _ -> + ?INTERNAL_ACTIVE_N + end, + + {ok, #state{active_n = InternalActiveN, + port = Port, first = true, transport = TransportInfo, dtls_options = DTLSOptions, @@ -92,10 +101,11 @@ init([Port, {TransportModule, _,_,_} = TransportInfo, EmOpts, InetOptions, DTLSO handle_call({accept, _}, _, #state{close = true} = State) -> {reply, {error, closed}, State}; -handle_call({accept, Accepter}, From, #state{first = true, +handle_call({accept, Accepter}, From, #state{active_n = N, + first = true, accepters = Accepters, listener = Socket} = State0) -> - next_datagram(Socket), + next_datagram(Socket, N), State = State0#state{first = false, accepters = queue:in({Accepter, From}, Accepters)}, {noreply, State}; @@ -137,19 +147,24 @@ handle_cast({active_once, Client, Pid}, State0) -> State = handle_active_once(Client, Pid, State0), {noreply, State}. -handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket, transport = {_,Transport,_,_}} = State0) -> +handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket, transport = {_,Transport,_,_,_}} = State0) -> State = handle_datagram({IP, InPortNo}, Msg, State0), - next_datagram(Socket), {noreply, State}; +handle_info({PassiveTag, Socket}, + #state{active_n = N, + listener = Socket, + transport = {_,_,_, udp_error, PassiveTag}}) -> + next_datagram(Socket, N); + %% UDP socket does not have a connection and should not receive an econnreset %% This does however happens on some windows versions. Just ignoring it %% appears to make things work as expected! -handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) -> +handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error,_}} = State) -> Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State}; -handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag}} = State) -> +handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag,_}} = State) -> Report = io_lib:format("SSL Packet muliplxer shutdown: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State#state{close=true}}; @@ -211,8 +226,8 @@ dispatch(Client, Msg, #state{dtls_msq_queues = MsgQueues} = State) -> kv_update(Client, queue:in(Msg, Queue), MsgQueues)} end end. -next_datagram(Socket) -> - inet:setopts(Socket, [{active, once}]). +next_datagram(Socket, N) -> + inet:setopts(Socket, [{active, N}]). handle_active_once(Client, Pid, #state{dtls_msq_queues = MsgQueues} = State0) -> Queue0 = kv_get(Client, MsgQueues), diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index 4d07372e31..b305d08f70 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -45,7 +45,7 @@ listen(Port, #config{transport_info = TransportInfo, Err end. -accept(dtls, #config{transport_info = {Transport,_,_,_}, +accept(dtls, #config{transport_info = {Transport,_,_,_,_}, connection_cb = ConnectionCb, dtls_handler = {Listner, _}}, _Timeout) -> case dtls_packet_demux:accept(Listner, self()) of @@ -55,7 +55,7 @@ accept(dtls, #config{transport_info = {Transport,_,_,_}, {error, Reason} end. -connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo, +connect(Address, Port, #config{transport_info = {Transport, _, _, _, _} = CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, emulated = EmOpts, @@ -174,7 +174,7 @@ default_inet_values() -> [{active, true}, {mode, list}, {packet, 0}, {packet_size, 0}]. default_cb_info() -> - {gen_udp, udp, udp_closed, udp_error}. + {gen_udp, udp, udp_closed, udp_error, udp_passive}. get_emulated_opts(EmOpts, EmOptNames) -> lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), 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 8807c575b1..6af65e09f2 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -35,27 +35,69 @@ -include("ssl_srp.hrl"). %% Application handling --export([start/0, start/1, stop/0, clear_pem_cache/0]). +-export([start/0, + start/1, + stop/0, + clear_pem_cache/0]). %% Socket handling --export([connect/3, connect/2, connect/4, - listen/2, transport_accept/1, transport_accept/2, - handshake/1, handshake/2, handshake/3, handshake_continue/2, - handshake_continue/3, handshake_cancel/1, - ssl_accept/1, ssl_accept/2, ssl_accept/3, - controlling_process/2, peername/1, peercert/1, sockname/1, - close/1, close/2, shutdown/2, recv/2, recv/3, send/2, - getopts/2, setopts/2, getstat/1, getstat/2 +-export([connect/3, + connect/2, + connect/4, + listen/2, + transport_accept/1, + transport_accept/2, + handshake/1, + handshake/2, + handshake/3, + handshake_continue/2, + handshake_continue/3, + handshake_cancel/1, + ssl_accept/1, + ssl_accept/2, + ssl_accept/3, + controlling_process/2, + peername/1, + peercert/1, + sockname/1, + close/1, + close/2, + shutdown/2, + recv/2, + recv/3, + send/2, + getopts/2, + setopts/2, + getstat/1, + getstat/2 ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2, - prepend_cipher_suites/2, append_cipher_suites/2, - eccs/0, eccs/1, versions/0, groups/0, groups/1, - format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, - connection_information/1, connection_information/2]). +-export([cipher_suites/0, + cipher_suites/1, + cipher_suites/2, + cipher_suites/3, + filter_cipher_suites/2, + prepend_cipher_suites/2, + append_cipher_suites/2, + eccs/0, + eccs/1, + versions/0, + groups/0, + groups/1, + format_error/1, + renegotiate/1, + prf/5, + negotiated_protocol/1, + connection_information/1, + connection_information/2]). %% Misc --export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1]). +-export([handle_options/2, + tls_version/1, + new_ssl_options/3, + suite_to_str/1, + suite_to_openssl_str/1, + str_to_suite/1]). -deprecated({ssl_accept, 1, eventually}). -deprecated({ssl_accept, 2, eventually}). @@ -86,27 +128,28 @@ srp_param_type/0]). %% ------------------------------------------------------------------------------------------------------- --type socket() :: gen_tcp:socket(). --type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option(). --type sslsocket() :: any(). --type tls_option() :: tls_client_option() | tls_server_option(). --type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option(). --type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option(). + +-type socket() :: gen_tcp:socket(). % exported +-type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option(). % exported +-type sslsocket() :: any(). % exported +-type tls_option() :: tls_client_option() | tls_server_option(). % exported +-type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option(). % exported +-type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option(). % exported -type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | - {ssl_error, sslsocket(), Reason::term()} | {ssl_passive, sslsocket()}. + {ssl_error, sslsocket(), Reason::any()} | {ssl_passive, sslsocket()}. % exported -type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag::atom()}} | {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag::atom(), PassiveTag::atom()}}. --type host() :: hostname() | ip_address(). +-type host() :: hostname() | ip_address(). % exported -type hostname() :: string(). -type ip_address() :: inet:ip_address(). --type session_id() :: binary(). --type protocol_version() :: tls_version() | dtls_version(). +-type session_id() :: binary(). % exported +-type protocol_version() :: tls_version() | dtls_version(). % exported -type tls_version() :: 'tlsv1.2' | 'tlsv1.3' | tls_legacy_version(). -type dtls_version() :: 'dtlsv1.2' | dtls_legacy_version(). -type tls_legacy_version() :: tlsv1 | 'tlsv1.1' | sslv3. --type dtls_legacy_version() :: 'dtlsv1'. +-type dtls_legacy_version() :: 'dtlsv1'. -type verify_type() :: verify_none | verify_peer. -type cipher() :: aes_128_cbc | aes_256_cbc | @@ -117,14 +160,14 @@ aes_128_ccm_8 | aes_256_ccm_8 | chacha20_poly1305 | - legacy_cipher(). + legacy_cipher(). % exported -type legacy_cipher() :: rc4_128 | des_cbc | '3des_ede_cbc'. -type hash() :: sha | sha2() | - legacy_hash(). + legacy_hash(). % exported -type sha2() :: sha224 | sha256 | @@ -133,7 +176,7 @@ -type legacy_hash() :: md5. --type sign_algo() :: rsa | dsa | ecdsa. +-type sign_algo() :: rsa | dsa | ecdsa. % exported -type sign_scheme() :: rsa_pkcs1_sha256 | rsa_pkcs1_sha384 @@ -155,7 +198,7 @@ srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon | - any. %% TLS 1.3 + any. %% TLS 1.3 , exported -type erl_cipher_suite() :: #{key_exchange := kex_algo(), cipher := cipher(), mac := hash() | aead, @@ -195,15 +238,18 @@ secp160r1 | secp160r2. +-type group() :: secp256r1 | secp384r1 | secp521r1 | ffdhe2048 | + ffdhe3072 | ffdhe4096 | ffdhe6144 | ffdhe8192. + -type srp_param_type() :: srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | - srp_8192. + srp_8192. % exported --type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. +-type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. % exported -type tls_alert() :: close_notify | unexpected_message | @@ -234,6 +280,7 @@ bad_certificate_hash_value | unknown_psk_identity | no_application_protocol. + %% ------------------------------------------------------------------------------------------------------- -type common_option() :: {protocol, protocol()} | {handshake, handshake_completion()} | @@ -243,7 +290,7 @@ {keyfile, key_pem()} | {password, key_password()} | {ciphers, cipher_suites()} | - {eccs, eccs()} | + {eccs, [named_curve()]} | {signature_algs_cert, signature_schemes()} | {secure_renegotiate, secure_renegotiation()} | {depth, allowed_cert_chain_length()} | @@ -270,29 +317,28 @@ #{algorithm := rsa | dss | ecdsa, engine := crypto:engine_ref(), key_id := crypto:key_id(), - password => crypto:password()}. + password => crypto:password()}. % exported -type key_pem() :: file:filename(). -type key_password() :: string(). -type cipher_suites() :: ciphers(). -type ciphers() :: [erl_cipher_suite()] | - string(). % (according to old API) + string(). % (according to old API) exported -type cipher_filters() :: list({key_exchange | cipher | mac | prf, - algo_filter()}). + algo_filter()}). % exported -type algo_filter() :: fun((kex_algo()|cipher()|hash()|aead|default_prf) -> true | false). --type eccs() :: [named_curve()]. -type secure_renegotiation() :: boolean(). -type allowed_cert_chain_length() :: integer(). --type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: term()}. +-type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: any()}. -type crl_check() :: boolean() | peer | best_effort. --type crl_cache_opts() :: [term()]. +-type crl_cache_opts() :: [any()]. -type handshake_size() :: integer(). -type hibernate_after() :: timeout(). -type root_fun() :: fun(). -type protocol_versions() :: [protocol_version()]. -type signature_algs() :: [{hash(), sign_algo()}]. -type signature_schemes() :: [sign_scheme()]. --type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: term()}. +-type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: any()}. -type padding_check() :: boolean(). -type beast_mitigation() :: one_n_minus_one | zero_n | disabled. -type srp_identity() :: {Username :: string(), Password :: string()}. @@ -375,7 +421,7 @@ -type honor_ecc_order() :: boolean(). -type client_renegotiation() :: boolean(). %% ------------------------------------------------------------------------------------------------------- --type prf_random() :: client_random | server_random. +-type prf_random() :: client_random | server_random. % exported -type protocol_extensions() :: #{renegotiation_info => binary(), signature_algs => signature_algs(), alpn => app_level_protocol(), @@ -383,7 +429,7 @@ next_protocol => app_level_protocol(), ec_point_formats => [0..2], elliptic_curves => [public_key:oid()], - sni => hostname()}. + sni => hostname()}. % exported %% ------------------------------------------------------------------------------------------------------- %%%-------------------------------------------------------------------- @@ -419,14 +465,31 @@ stop() -> %% %% Description: Connect to an ssl server. %%-------------------------------------------------------------------- --spec connect(host() | port(), [tls_client_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. + +-spec connect(TCPSocket, TLSOptions) -> + {ok, sslsocket()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + TCPSocket :: socket(), + TLSOptions :: [tls_client_option()]. + connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). --spec connect(host() | port(), [tls_client_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec connect(TCPSocket, TLSOptions, Timeout) -> + {ok, sslsocket()} | {error, reason()} when + TCPSocket :: socket(), + TLSOptions :: [tls_client_option()], + Timeout :: timeout(); + (Host, Port, TLSOptions) -> + {ok, sslsocket()} | + {ok, sslsocket(),Ext :: protocol_extensions()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + Host :: host(), + Port :: inet:port_number(), + TLSOptions :: [tls_client_option()]. + connect(Socket, SslOptions0, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> CbInfo = handle_option(cb_info, SslOptions0, default_cb_info(tls)), @@ -443,8 +506,16 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. + +-spec connect(Host, Port, TLSOptions, Timeout) -> + {ok, sslsocket()} | + {ok, sslsocket(),Ext :: protocol_extensions()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + Host :: host(), + Port :: inet:port_number(), + TLSOptions :: [tls_client_option()], + Timeout :: timeout(). connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> try @@ -461,7 +532,10 @@ connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout end. %%-------------------------------------------------------------------- --spec listen(inet:port_number(), [tls_server_option()]) ->{ok, #sslsocket{}} | {error, reason()}. +-spec listen(Port, Options) -> {ok, ListenSocket} | {error, reason()} when + Port::inet:port_number(), + Options::[tls_server_option()], + ListenSocket :: sslsocket(). %% %% Description: Creates an ssl listen socket. @@ -480,13 +554,20 @@ listen(Port, Options0) -> %% %% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- --spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. +-spec transport_accept(ListenSocket) -> {ok, SslSocket} | + {error, reason()} when + ListenSocket :: sslsocket(), + SslSocket :: sslsocket(). + transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). --spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. +-spec transport_accept(ListenSocket, Timeout) -> {ok, SslSocket} | + {error, reason()} when + ListenSocket :: sslsocket(), + Timeout :: timeout(), + SslSocket :: sslsocket(). + transport_accept(#sslsocket{pid = {ListenSocket, #config{connection_cb = ConnectionCb} = Config}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> @@ -502,12 +583,22 @@ transport_accept(#sslsocket{pid = {ListenSocket, %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- --spec ssl_accept(#sslsocket{}) -> ok | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(SslSocket) -> + ok | + {error, Reason} when + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). + ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, [], infinity). --spec ssl_accept(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> - ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(Socket, TimeoutOrOptions) -> + ok | + {ok, sslsocket()} | {error, Reason} when + Socket :: sslsocket() | socket(), + TimeoutOrOptions :: timeout() | [tls_server_option()], + Reason :: timeout | closed | {options, any()} | error_alert(). + ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_accept(Socket, [], Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> @@ -515,8 +606,13 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(Socket, Timeout) -> ssl_accept(Socket, [], Timeout). --spec ssl_accept(#sslsocket{} | port(), [tls_server_option()], timeout()) -> - ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(Socket, Options, Timeout) -> + ok | {ok, sslsocket()} | {error, Reason} when + Socket :: sslsocket() | socket(), + Options :: [tls_server_option()], + Timeout :: timeout(), + Reason :: timeout | closed | {options, any()} | error_alert(). + ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> handshake(Socket, SslOptions, Timeout); ssl_accept(Socket, SslOptions, Timeout) -> @@ -533,13 +629,28 @@ ssl_accept(Socket, SslOptions, Timeout) -> %%-------------------------------------------------------------------- %% Performs the SSL/TLS/DTLS server-side handshake. --spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(HsSocket) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + HsSocket :: sslsocket(), + SslSocket :: sslsocket(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(). handshake(ListenSocket) -> handshake(ListenSocket, infinity). --spec handshake(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> - {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(HsSocket, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + HsSocket :: sslsocket(), + Timeout :: timeout(), + SslSocket :: sslsocket(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(); + (Socket, Options) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + Socket :: socket() | sslsocket(), + SslSocket :: sslsocket(), + Options :: [server_option()], + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(). + handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); @@ -553,8 +664,17 @@ handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Tim handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> handshake(ListenSocket, SslOptions, infinity). --spec handshake(#sslsocket{} | port(), [tls_server_option()], timeout()) -> - {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(Socket, Options, Timeout) -> + {ok, SslSocket} | + {ok, SslSocket, Ext} | + {error, Reason} when + Socket :: socket() | sslsocket(), + SslSocket :: sslsocket(), + Options :: [server_option()], + Timeout :: timeout(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | {options, any()} | error_alert(). + handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> handshake(Socket, Timeout); @@ -597,8 +717,12 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()]) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec handshake_continue(HsSocket, Options) -> + {ok, SslSocket} | {error, Reason} when + HsSocket :: sslsocket(), + Options :: [tls_client_option() | tls_server_option()], + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). %% %% %% Description: Continues the handshke possible with newly supplied options. @@ -606,8 +730,13 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), handshake_continue(Socket, SSLOptions) -> handshake_continue(Socket, SSLOptions, infinity). %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec handshake_continue(HsSocket, Options, Timeout) -> + {ok, SslSocket} | {error, Reason} when + HsSocket :: sslsocket(), + Options :: [tls_client_option() | tls_server_option()], + Timeout :: timeout(), + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). %% %% %% Description: Continues the handshke possible with newly supplied options. @@ -615,7 +744,7 @@ handshake_continue(Socket, SSLOptions) -> handshake_continue(Socket, SSLOptions, Timeout) -> ssl_connection:handshake_continue(Socket, SSLOptions, Timeout). %%-------------------------------------------------------------------- --spec handshake_cancel(#sslsocket{}) -> term(). +-spec handshake_cancel(#sslsocket{}) -> any(). %% %% Description: Cancels the handshakes sending a close alert. %%-------------------------------------------------------------------- @@ -623,7 +752,9 @@ handshake_cancel(Socket) -> ssl_connection:handshake_cancel(Socket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}) -> term(). +-spec close(SslSocket) -> ok | {error, Reason} when + SslSocket :: sslsocket(), + Reason :: any(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- @@ -635,7 +766,10 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}, timeout() | {pid(), integer()}) -> term(). +-spec close(SslSocket, How) -> ok | {ok, port()} | {error,Reason} when + SslSocket :: sslsocket(), + How :: timeout() | {NewController::pid(), timeout()}, + Reason :: any(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- @@ -651,7 +785,9 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. +-spec send(SslSocket, Data) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + Data :: iodata(). %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- @@ -671,11 +807,22 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info = Info}}}, Data) -> %% %% Description: Receives data when active = false %%-------------------------------------------------------------------- --spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. +-spec recv(SslSocket, Length) -> {ok, Data} | {error, reason()} when + SslSocket :: sslsocket(), + Length :: integer(), + Data :: binary() | list() | HttpPacket, + HttpPacket :: any(). + recv(Socket, Length) -> recv(Socket, Length, infinity). --spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. +-spec recv(SslSocket, Length, Timeout) -> {ok, Data} | {error, reason()} when + SslSocket :: sslsocket(), + Length :: integer(), + Data :: binary() | list() | HttpPacket, + Timeout :: timeout(), + HttpPacket :: any(). + recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); @@ -687,7 +834,10 @@ recv(#sslsocket{pid = {Listen, Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- --spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. +-spec controlling_process(SslSocket, NewOwner) -> ok | {error, Reason} when + SslSocket :: sslsocket(), + NewOwner :: pid(), + Reason :: any(). %% %% Description: Changes process that receives the messages when active = true %% or once. @@ -706,7 +856,11 @@ controlling_process(#sslsocket{pid = {Listen, %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}) -> {ok, list()} | {error, reason()}. +-spec connection_information(SslSocket) -> {ok, Result} | {error, reason()} when + SslSocket :: sslsocket(), + Result :: [{OptionName, OptionValue}], + OptionName :: atom(), + OptionValue :: any(). %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- @@ -723,7 +877,12 @@ connection_information(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. +-spec connection_information(SslSocket, Items) -> {ok, Result} | {error, reason()} when + SslSocket :: sslsocket(), + Items :: [OptionName], + Result :: [{OptionName, OptionValue}], + OptionName :: atom(), + OptionValue :: any(). %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- @@ -737,7 +896,11 @@ connection_information(#sslsocket{pid = [Pid|_]}, Items) when is_pid(Pid) -> end. %%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +-spec peername(SslSocket) -> {ok, {Address, Port}} | + {error, reason()} when + SslSocket :: sslsocket(), + Address :: inet:ip_address(), + Port :: inet:port_number(). %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- @@ -753,7 +916,9 @@ peername(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. %%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. +-spec peercert(SslSocket) -> {ok, Cert} | {error, reason()} when + SslSocket :: sslsocket(), + Cert :: binary(). %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- @@ -770,7 +935,10 @@ peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +-spec negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, Reason} when + SslSocket :: sslsocket(), + Protocol :: binary(), + Reason :: protocol_not_negotiated. %% %% Description: Returns the protocol that has been negotiated. If no %% protocol has been negotiated will return {error, protocol_not_negotiated} @@ -784,24 +952,26 @@ negotiated_protocol(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all) -> - [old_cipher_suite() | string()]. +-spec cipher_suites(Type) -> [old_cipher_suite() | string()] when + Type :: erlang | openssl | all. + %% 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(default | all | anonymous, ssl_record:ssl_version() | - tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> - [erl_cipher_suite()]. +-spec cipher_suites(Supported, Version) -> ciphers() when + Supported :: default | all | anonymous, + Version :: protocol_version(). + %% Description: Returns all default and all supported cipher suites for a %% TLS/DTLS version %%-------------------------------------------------------------------- @@ -814,12 +984,36 @@ 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 cipher_suites(Supported, Version, rfc | openssl) -> [string()] when + Supported :: default | all | anonymous, + Version :: protocol_version(). +%% Description: Returns all default and all supported cipher suites for a +%% TLS/DTLS version %%-------------------------------------------------------------------- --spec filter_cipher_suites([erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()] , - [{key_exchange | cipher | mac | prf, fun()}] | []) -> - [erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. +cipher_suites(Base, Version, StringType) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + cipher_suites(Base, tls_record:protocol_version(Version), StringType); +cipher_suites(Base, Version, StringType) when Version == 'dtlsv1.2'; + Version == 'dtlsv1'-> + cipher_suites(Base, dtls_record:protocol_version(Version), StringType); +cipher_suites(Base, Version, rfc) -> + [ssl_cipher_format:suite_map_to_str(ssl_cipher_format:suite_bin_to_map(Suite)) + || Suite <- supported_suites(Base, Version)]; +cipher_suites(Base, Version, openssl) -> + [ssl_cipher_format:suite_map_to_openssl_str(ssl_cipher_format:suite_bin_to_map(Suite)) + || Suite <- supported_suites(Base, Version)]. + +%%-------------------------------------------------------------------- +-spec filter_cipher_suites(Suites, Filters) -> Ciphers when + Suites :: ciphers(), + Filters :: cipher_filters(), + Ciphers :: ciphers(). %% Description: Removes cipher suites if any of the filter functions returns false %% for any part of the cipher suite. This function also calls default filter functions @@ -837,10 +1031,10 @@ filter_cipher_suites(Suites, Filters0) -> prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, ssl_cipher:filter_suites(Suites, Filters). %%-------------------------------------------------------------------- --spec prepend_cipher_suites([erl_cipher_suite()] | - [{key_exchange | cipher | mac | prf, fun()}], - [erl_cipher_suite()]) -> - [erl_cipher_suite()]. +-spec prepend_cipher_suites(Preferred, Suites) -> ciphers() when + Preferred :: ciphers() | cipher_filters(), + Suites :: ciphers(). + %% Description: Make <Preferred> suites become the most prefered %% suites that is put them at the head of the cipher suite list %% and remove them from <Suites> if present. <Preferred> may be a @@ -855,10 +1049,10 @@ prepend_cipher_suites(Filters, Suites) -> Preferred = filter_cipher_suites(Suites, Filters), Preferred ++ (Suites -- Preferred). %%-------------------------------------------------------------------- --spec append_cipher_suites(Deferred :: [erl_cipher_suite()] | - [{key_exchange | cipher | mac | prf, fun()}], - [erl_cipher_suite()]) -> - [erl_cipher_suite()]. +-spec append_cipher_suites(Deferred, Suites) -> ciphers() when + Deferred :: ciphers() | cipher_filters(), + Suites :: ciphers(). + %% Description: Make <Deferred> suites suites become the %% least prefered suites that is put them at the end of the cipher suite list %% and removed them from <Suites> if present. @@ -872,7 +1066,9 @@ append_cipher_suites(Filters, Suites) -> (Suites -- Deferred) ++ Deferred. %%-------------------------------------------------------------------- --spec eccs() -> tls_v1:curves(). +-spec eccs() -> NamedCurves when + NamedCurves :: [named_curve()]. + %% Description: returns all supported curves across all versions %%-------------------------------------------------------------------- eccs() -> @@ -880,27 +1076,24 @@ eccs() -> eccs_filter_supported(Curves). %%-------------------------------------------------------------------- --spec eccs(tls_record:tls_atom_version() | - ssl_record:ssl_version() | dtls_record:dtls_atom_version()) -> - tls_v1:curves(). +-spec eccs(Version) -> NamedCurves when + Version :: protocol_version(), + NamedCurves :: [named_curve()]. + %% Description: returns the curves supported for a given version of %% ssl/tls. %%-------------------------------------------------------------------- -eccs({3,0}) -> +eccs(sslv3) -> []; -eccs({3,_}) -> - Curves = tls_v1:ecc_curves(all), - eccs_filter_supported(Curves); -eccs({254,_} = Version) -> - eccs(dtls_v1:corresponding_tls_version(Version)); +eccs('dtlsv1') -> + eccs('tlsv1.1'); +eccs('dtlsv1.2') -> + eccs('tlsv1.2'); eccs(Version) when Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> - eccs(tls_record:protocol_version(Version)); -eccs(Version) when Version == 'dtlsv1.2'; - Version == 'dtlsv1'-> - eccs(dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Version))). + Version == tlsv1 -> + Curves = tls_v1:ecc_curves(all), + eccs_filter_supported(Curves). eccs_filter_supported(Curves) -> CryptoCurves = crypto:ec_curves(), @@ -908,28 +1101,30 @@ eccs_filter_supported(Curves) -> Curves). %%-------------------------------------------------------------------- --spec groups() -> tls_v1:supported_groups(). +-spec groups() -> [group()]. %% Description: returns all supported groups (TLS 1.3 and later) %%-------------------------------------------------------------------- groups() -> tls_v1:groups(4). %%-------------------------------------------------------------------- --spec groups(default) -> tls_v1:supported_groups(). +-spec groups(default) -> [group()]. %% Description: returns the default groups (TLS 1.3 and later) %%-------------------------------------------------------------------- groups(default) -> tls_v1:default_groups(4). %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> - {ok, [gen_tcp:option()]} | {error, reason()}. +-spec getopts(SslSocket, OptionNames) -> + {ok, [gen_tcp:option()]} | {error, reason()} when + SslSocket :: sslsocket(), + OptionNames :: [gen_tcp:option_name()]. %% %% Description: Gets options %%-------------------------------------------------------------------- getopts(#sslsocket{pid = [Pid|_]}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> +getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try dtls_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> Result; @@ -954,7 +1149,9 @@ getopts(#sslsocket{}, OptionTags) -> {error, {options, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. +-spec setopts(SslSocket, Options) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + Options :: [gen_tcp:option()]. %% %% Description: Sets options %%-------------------------------------------------------------------- @@ -986,7 +1183,7 @@ setopts(#sslsocket{pid = [Pid|_]}, Options0) when is_pid(Pid), is_list(Options0) _:_ -> {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try dtls_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -1010,9 +1207,9 @@ setopts(#sslsocket{}, Options) -> {error, {options,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- --spec getstat(Socket) -> - {ok, OptionValues} | {error, inet:posix()} when - Socket :: #sslsocket{}, +-spec getstat(SslSocket) -> + {ok, OptionValues} | {error, inet:posix()} when + SslSocket :: sslsocket(), OptionValues :: [{inet:stat_option(), integer()}]. %% %% Description: Get all statistic options for a socket. @@ -1021,22 +1218,24 @@ getstat(Socket) -> getstat(Socket, inet:stats()). %%--------------------------------------------------------------- --spec getstat(Socket, Options) -> - {ok, OptionValues} | {error, inet:posix()} when - Socket :: #sslsocket{}, +-spec getstat(SslSocket, Options) -> + {ok, OptionValues} | {error, inet:posix()} when + SslSocket :: sslsocket(), Options :: [inet:stat_option()], OptionValues :: [{inet:stat_option(), integer()}]. %% %% Description: Get one or more statistic options for a socket. %%-------------------------------------------------------------------- -getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> +getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> tls_socket:getstat(Transport, Listen, Options); getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when is_pid(Pid), is_list(Options) -> tls_socket:getstat(Transport, Socket, Options). %%--------------------------------------------------------------- --spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. +-spec shutdown(SslSocket, How) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + How :: read | write | read_write. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- @@ -1050,7 +1249,11 @@ shutdown(#sslsocket{pid = [Pid|_]}, How) when is_pid(Pid) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- --spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +-spec sockname(SslSocket) -> + {ok, {Address, Port}} | {error, reason()} when + SslSocket :: sslsocket(), + Address :: inet:ip_address(), + Port :: inet:port_number(). %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- @@ -1064,10 +1267,10 @@ sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket,_,_}}) when is_pid(P tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- --spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} | - {supported_dtls, [dtls_record:dtls_atom_version()]} | - {available, [tls_record:tls_atom_version()]} | - {available_dtls, [dtls_record:dtls_atom_version()]}]. +-spec versions() -> [VersionInfo] when + VersionInfo :: {ssl_app, string()} | + {supported | available, [tls_version()]} | + {supported_dtls | available_dtls, [dtls_version()]}. %% %% Description: Returns a list of relevant versions. %%-------------------------------------------------------------------- @@ -1085,7 +1288,8 @@ versions() -> %%--------------------------------------------------------------- --spec renegotiate(#sslsocket{}) -> ok | {error, reason()}. +-spec renegotiate(SslSocket) -> ok | {error, reason()} when + SslSocket :: sslsocket(). %% %% Description: Initiates a renegotiation. %%-------------------------------------------------------------------- @@ -1105,9 +1309,13 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec prf(#sslsocket{}, binary() | 'master_secret', binary(), - [binary() | prf_random()], non_neg_integer()) -> - {ok, binary()} | {error, reason()}. +-spec prf(SslSocket, Secret, Label, Seed, WantedLength) -> + {ok, binary()} | {error, reason()} when + SslSocket :: sslsocket(), + Secret :: binary() | 'master_secret', + Label::binary(), + Seed :: [binary() | prf_random()], + WantedLength :: non_neg_integer(). %% %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- @@ -1128,7 +1336,8 @@ clear_pem_cache() -> ssl_pem_cache:clear(). %%--------------------------------------------------------------- --spec format_error({error, term()}) -> list(). +-spec format_error({error, Reason}) -> string() when + Reason :: any(). %% %% Description: Creates error string. %%-------------------------------------------------------------------- @@ -1166,19 +1375,54 @@ tls_version({3, _} = Version) -> tls_version({254, _} = Version) -> dtls_v1:corresponding_tls_version(Version). - %%-------------------------------------------------------------------- --spec suite_to_str(erl_cipher_suite()) -> string(). +-spec suite_to_str(CipherSuite) -> string() when + CipherSuite :: erl_cipher_suite(); + (CipherSuite) -> string() when + %% For internal use! + CipherSuite :: #{key_exchange := null, + cipher := null, + mac := null, + prf := null}. %% %% 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). +%%-------------------------------------------------------------------- +-spec suite_to_openssl_str(CipherSuite) -> string() when + CipherSuite :: erl_cipher_suite(). +%% +%% Description: Return the string representation of a cipher suite. +%%-------------------------------------------------------------------- +suite_to_openssl_str(Cipher) -> + ssl_cipher_format:suite_map_to_openssl_str(Cipher). +%% +%%-------------------------------------------------------------------- +-spec str_to_suite(CipherSuiteName) -> erl_cipher_suite() when + CipherSuiteName :: string() | {error, {not_recognized, CipherSuiteName :: string()}}. +%% +%% Description: Return the map representation of a cipher suite. +%%-------------------------------------------------------------------- +str_to_suite(CipherSuiteName) -> + try + %% Note in TLS-1.3 OpenSSL conforms to RFC names + %% so if CipherSuiteName starts with TLS this + %% function will call ssl_cipher_format:suite_str_to_map + %% so both RFC names and legacy OpenSSL names of supported + %% cipher suites will be handled + ssl_cipher_format:suite_openssl_str_to_map(CipherSuiteName) + catch + _:_ -> + {error, {not_recognized, CipherSuiteName}} + end. + %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- + %% Possible filters out suites not supported by crypto available_suites(default) -> Version = tls_record:highest_protocol_version([]), @@ -1814,10 +2058,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) ++ @@ -1832,11 +2076,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) -> @@ -2141,7 +2385,7 @@ default_option_role(_,_,_) -> default_cb_info(tls) -> {gen_tcp, tcp, tcp_closed, tcp_error, tcp_passive}; default_cb_info(dtls) -> - {gen_udp, udp, udp_closed, udp_error}. + {gen_udp, udp, udp_closed, udp_error, udp_passive}. include_security_info([]) -> false; diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 97878431a6..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()]) -> @@ -838,8 +838,7 @@ effective_key_bits(Cipher) when Cipher == aes_256_cbc; 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_128; - Cipher == chacha20_poly1305-> + Cipher == rc4_128 -> 0; iv_size(Cipher) when Cipher == aes_128_gcm; Cipher == aes_256_gcm; @@ -848,6 +847,8 @@ iv_size(Cipher) when Cipher == aes_128_gcm; Cipher == aes_128_ccm_8; Cipher == aes_256_ccm_8 -> 4; +iv_size(chacha20_poly1305) -> + 12; iv_size(Cipher) -> block_size(Cipher). @@ -938,6 +939,11 @@ signature_scheme(?RSA_PSS_PSS_SHA384) -> rsa_pss_pss_sha384; signature_scheme(?RSA_PSS_PSS_SHA512) -> rsa_pss_pss_sha512; signature_scheme(?RSA_PKCS1_SHA1) -> rsa_pkcs1_sha1; signature_scheme(?ECDSA_SHA1) -> ecdsa_sha1; +%% Handling legacy signature algorithms for logging purposes. These algorithms +%% cannot be used in TLS 1.3 handshakes. +signature_scheme(SignAlgo) when is_integer(SignAlgo) -> + <<?BYTE(Hash),?BYTE(Sign)>> = <<?UINT16(SignAlgo)>>, + {ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)}; signature_scheme(_) -> unassigned. %% TODO: reserved code points? diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 5d2f5e2951..0fa5f66c49 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -601,16 +601,30 @@ %% TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x32}; -define(TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#32)>>). -%%% Chacha20/Poly1305 Suites draft-agl-tls-chacha20poly1305-04 -%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x13} --define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#13)>>). +%%% ChaCha20-Poly1305 Cipher Suites for Transport Layer Security (TLS) RFC7905 -%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14} --define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>). +%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA8} +-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A8)>>). + +%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA9} +-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A9)>>). + +%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAA} +-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AA)>>). + +%% TLS_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAB} +-define(TLS_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AB)>>). + +%% TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAC} +-define(TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AC)>>). + +%% TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAD} +-define(TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AD)>>). + +%% TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAE} +-define(TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AE)>>). -%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15} --define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>). %% RFC 6655 - TLS-1.2 cipher suites @@ -676,9 +690,9 @@ -define(TLS_CHACHA20_POLY1305_SHA256, <<?BYTE(16#13),?BYTE(16#03)>>). %% %% TLS_AES_128_CCM_SHA256 = {0x13,0x04} -%% -define(TLS_AES_128_CCM_SHA256, <<?BYTE(16#13), ?BYTE(16#04)>>). +-define(TLS_AES_128_CCM_SHA256, <<?BYTE(16#13), ?BYTE(16#04)>>). %% %% TLS_AES_128_CCM_8_SHA256 = {0x13,0x05} -%% -define(TLS_AES_128_CCM_8_SHA256, <<?BYTE(16#13),?BYTE(16#05)>>). +-define(TLS_AES_128_CCM_8_SHA256, <<?BYTE(16#13),?BYTE(16#05)>>). -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index 8737181922..bca1022b5f 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -48,48 +48,154 @@ -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:prefix(SuiteStr, "TLS_"), + case string:split(Str0, "_WITH_") of + [Rest] -> + tls_1_3_suite_str_to_map(Rest); + [Prefix, Kex | Rest] when Prefix == "SPR"; + Prefix == "PSK"; + Prefix == "DHE"; + Prefix == "ECDHE" + -> + pre_tls_1_3_suite_str_to_map(Prefix ++ "_" ++ Kex, 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 := rsa = Kex, + cipher := Cipher, + mac := Mac}) when Cipher == "des_cbc"; + Cipher == "3des_ede_cbc" -> + openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(Mac)); +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("DES-CBC-SHA") -> + suite_str_to_map("TLS_RSA_WITH_DES_CBC_SHA"); +suite_openssl_str_to_map("DES-CBC3-SHA") -> + suite_str_to_map("TLS_RSA_WITH_3DES_EDE_CBC_SHA"); +suite_openssl_str_to_map("SRP-DSS-DES-CBC3-SHA") -> + suite_str_to_map("TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA"); +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-DSS-" ++ Rest) -> + suite_openssl_str_to_map("SRP-DSS", 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 +203,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 +319,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) -> + prf => sha384}; +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) -> + prf => sha384}; +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) -> + prf => sha384}; +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) -> + prf => sha384}; +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) -> + prf => sha384}; +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}; + prf => sha384}; %%% 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) -> + prf => sha384}; +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}; + prf => sha384}; %%% 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) -> + prf => 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}; + 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) -> -%% #{key_exchange => any, -%% cipher => aes_128_ccm, -%% mac => aead, -%% prf => sha256}; -%% suite_definition(?TLS_AES_128_CCM_8_SHA256) -> + prf => sha256}; +suite_bin_to_map(?TLS_AES_128_CCM_SHA256) -> + #{key_exchange => any, + cipher => aes_128_ccm, + mac => aead, + prf => 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,1077 +1005,915 @@ 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, -%% cipher := aes_128_ccm, -%% mac := aead, -%% prf := sha256}) -> -%% ?TLS_AES_128_CCM_SHA256; -%% suite(#{key_exchange := any, + ?TLS_CHACHA20_POLY1305_SHA256; +suite_map_to_bin(#{key_exchange := any, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_AES_128_CCM_SHA256. +%% 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(any, 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(Kex, 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(Kex, 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(Kex, Hash)} + 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; +default_prf(_, md5) -> + default_prf; +default_prf(_, sha) -> + default_prf; +default_prf(ecdhe_ecdsa, sha256) -> + sha256; +default_prf(ecdhe_rsa, sha256) -> + sha256; +default_prf(dhe_rsa, sha256) -> + default_prf; +default_prf(dhe_dss, sha256) -> + default_prf; +default_prf(rsa, sha256) -> + default_prf; +default_prf(rsa_psk, sha256) -> + default_prf; +default_prf(_, Hash) -> + Hash. -%% 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. +%% 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"). +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. -%%-------------------------------------------------------------------- --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"; +algo_str_to_atom("SRP_SHA_DSS") -> + srp_dss; +algo_str_to_atom(AlgoStr) -> + erlang:list_to_existing_atom(string:to_lower(AlgoStr)). -%%% PSK Cipher Suites RFC 4279 +openssl_cipher_name(_, "3DES_EDE_CBC" ++ _) -> + "DES-CBC3"; +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("DES-CBC") -> + "DES_CBC"; +cipher_name_from_openssl("DES-CBC3") -> + "3DES_EDE_CBC"; +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(Kex, 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(Kex, 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, default_prf(Kex, 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"; -%% 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 1e97fe046b..a5f754d2e3 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -115,7 +115,7 @@ handshake(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> %%-------------------------------------------------------------------- -spec handshake(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {ok, #sslsocket{}, map()}| {error, reason()}. + {ok, #sslsocket{}, map()}| {error, reason()}. %% %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- @@ -130,8 +130,8 @@ handshake(#sslsocket{pid = [Pid|_]} = Socket, Timeout) -> end. %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}}, - timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}}, timeout()) -> + {ok, #sslsocket{}} | {ok, #sslsocket{}, map()} | {error, reason()}. %% %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- @@ -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 6c95a7edf8..7b34991f4f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -98,7 +98,7 @@ hello_request() -> #hello_request{}. %%-------------------------------------------------------------------- --spec server_hello(#session{}, ssl_record:ssl_version(), ssl_record:connection_states(), +-spec server_hello(binary(), ssl_record:ssl_version(), ssl_record:connection_states(), Extension::map()) -> #server_hello{}. %% %% Description: Creates a server hello message. @@ -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); @@ -2421,7 +2421,7 @@ decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Version, MessageType = hello_retry_request, Acc) -> - <<?UINT16(Group),Rest/binary>> = ExtData, + <<?UINT16(Group)>> = ExtData, decode_extensions(Rest, Version, MessageType, Acc#{key_share => #key_share_hello_retry_request{ @@ -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_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 4ee0230d88..06c3ccae45 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -28,12 +28,12 @@ -define(VSN, "8.2.6"). -define(SECRET_PRINTOUT, "***"). --type reason() :: term(). --type reply() :: term(). --type msg() :: term(). --type from() :: term(). +-type reason() :: any(). +-type reply() :: any(). +-type msg() :: any(). +-type from() :: any(). -type certdb_ref() :: reference(). --type db_handle() :: term(). +-type db_handle() :: any(). -type der_cert() :: binary(). -type issuer() :: tuple(). -type serialnumber() :: integer(). @@ -109,26 +109,26 @@ -define('24H_in_sec', 86400). -record(ssl_options, { - protocol :: tls | dtls, - versions :: [ssl_record:ssl_version()], %% ssl_record:atom_version() in API - verify :: verify_none | verify_peer, + protocol :: tls | dtls | 'undefined', + versions :: [ssl_record:ssl_version()] | 'undefined', %% ssl_record:atom_version() in API + verify :: verify_none | verify_peer | 'undefined', verify_fun, %%:: fun(CertVerifyErrors::term()) -> boolean(), - partial_chain :: fun(), - fail_if_no_peer_cert :: boolean(), - verify_client_once :: boolean(), + partial_chain :: fun() | 'undefined', + fail_if_no_peer_cert :: boolean() | 'undefined', + verify_client_once :: boolean() | 'undefined', %% fun(Extensions, State, Verify, AccError) -> {Extensions, State, AccError} validate_extensions_fun, - depth :: integer(), - certfile :: binary(), + depth :: integer() | 'undefined', + certfile :: binary() | 'undefined', cert :: public_key:der_encoded() | secret_printout() | 'undefined', - keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', + keyfile :: binary() | 'undefined', + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo' | 'undefined', public_key:der_encoded()} | map() %%map() -> ssl:key() how to handle dialyzer? | secret_printout() | 'undefined', password :: string() | secret_printout() | 'undefined', cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined', - cacertfile :: binary(), - dh :: public_key:der_encoded() | secret_printout(), + cacertfile :: binary() | 'undefined', + dh :: public_key:der_encoded() | secret_printout() | 'undefined', dhfile :: binary() | secret_printout() | 'undefined', user_lookup_fun, % server option, fun to lookup the user psk_identity :: binary() | secret_printout() | 'undefined', @@ -140,23 +140,23 @@ reuse_session :: fun() | binary() | undefined, %% Server side is a fun() %% If false sessions will never be reused, if true they %% will be reused if possible. - reuse_sessions :: boolean() | save, %% Only client side can use value save + reuse_sessions :: boolean() | save | 'undefined', %% Only client side can use value save renegotiate_at, secure_renegotiate, client_renegotiation, %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: timeout(), + hibernate_after :: timeout() | 'undefined', %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), - alpn_advertised_protocols = undefined :: [binary()] | undefined , + alpn_advertised_protocols = undefined :: [binary()] | undefined, alpn_preferred_protocols = undefined :: [binary()] | undefined, next_protocols_advertised = undefined :: [binary()] | undefined, next_protocol_selector = undefined, %% fun([binary()]) -> binary()) log_level = notice :: atom(), server_name_indication = undefined, - sni_hosts :: [{inet:hostname(), [tuple()]}], + sni_hosts :: [{inet:hostname(), [tuple()]}] | 'undefined', sni_fun :: function() | undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? @@ -166,14 +166,14 @@ %%mitigation entirely? beast_mitigation = one_n_minus_one :: one_n_minus_one | zero_n | disabled, fallback = false :: boolean(), - crl_check :: boolean() | peer | best_effort, + crl_check :: boolean() | peer | best_effort | 'undefined', crl_cache, signature_algs, signature_algs_cert, eccs, supported_groups, %% RFC 8422, RFC 8446 - honor_ecc_order :: boolean(), - max_handshake_size :: integer(), + honor_ecc_order :: boolean() | 'undefined', + max_handshake_size :: integer() | 'undefined', handshake, customize_hostname_check %% , @@ -199,9 +199,9 @@ }). -type state_name() :: hello | abbreviated | certify | cipher | connection. --type gen_fsm_state_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {stop, term(), term()}. +-type gen_fsm_state_return() :: {next_state, state_name(), any()} | + {next_state, state_name(), any(), timeout()} | + {stop, any(), any()}. -type ssl_options() :: #ssl_options{}. -endif. % -ifdef(ssl_internal). 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/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 9cc131c3cb..867d2cfc5a 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -395,7 +395,7 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment try Nonce = decrypt_nonce(Type, CipherState, CipherFragment), {AAD, CipherText, CipherTag} = aead_ciphertext_split(Type, CipherState, CipherFragment, AAD0), - case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of + case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of Content when is_binary(Content) -> Content; _ -> @@ -473,7 +473,7 @@ initial_security_params(ConnectionEnd) -> do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key, tag_len = TagLen} = CipherState, AAD0) -> AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)), - Nonce = encrypt_nonce(Type, CipherState), + Nonce = chacha_nonce(CipherState), {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen), {<<Content/binary, CipherTag/binary>>, CipherState}; do_cipher_aead(Type, Fragment, #cipher_state{key=Key, tag_len = TagLen, nonce = ExplicitNonce} = CipherState, AAD0) -> @@ -482,16 +482,18 @@ do_cipher_aead(Type, Fragment, #cipher_state{key=Key, tag_len = TagLen, nonce = {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen), {<<ExplicitNonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = ExplicitNonce + 1}}. -encrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}) -> - crypto:exor(<<?UINT32(0), Nonce/binary>>, IV); + +chacha_nonce(#cipher_state{nonce = Nonce, iv = IV}) -> + crypto:exor(<<?UINT32(0), Nonce/binary>>, IV). + encrypt_nonce(Type, #cipher_state{iv = IV, nonce = ExplicitNonce}) when Type == ?AES_GCM; Type == ?AES_CCM; Type == ?AES_CCM_8 -> <<Salt:4/bytes, _/binary>> = IV, <<Salt/binary, ExplicitNonce:64/integer>>. -decrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}, _) -> - crypto:exor(<<Nonce:96/unsigned-big-integer>>, IV); +decrypt_nonce(?CHACHA20_POLY1305, CipherState, _) -> + chacha_nonce(CipherState); decrypt_nonce(Type, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) when Type == ?AES_GCM; Type == ?AES_CCM; diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index a05858221a..872a557e67 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -171,19 +171,21 @@ next_record(#state{protocol_buffers = connection_states = ConnectionStates, ssl_options = #ssl_options{padding_check = Check}} = State) -> next_record(State, CipherTexts, ConnectionStates, Check); -next_record(#state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, - protocol_specific = #{active_n_toggle := true, active_n := N} = ProtocolSpec, +next_record(#state{user_data_buffer = {_,0,_}, + protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, + protocol_specific = #{active_n_toggle := true, + active_n := N} = ProtocolSpec, static_env = #static_env{socket = Socket, close_tag = CloseTag, transport_cb = Transport} - } = State) -> + } = State) -> case tls_socket:setopts(Transport, Socket, [{active, N}]) of ok -> - {no_record, State#state{protocol_specific = ProtocolSpec#{active_n_toggle => false}}}; + {no_record, State#state{protocol_specific = ProtocolSpec#{active_n_toggle => false}}}; _ -> - self() ! {CloseTag, Socket}, - {no_record, State} - end; + self() ! {CloseTag, Socket}, + {no_record, State} + end; next_record(State) -> {no_record, State}. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index e7cee1956b..2480e05097 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -251,7 +251,7 @@ encode_handshake(Package, Version) -> %%-------------------------------------------------------------------- -spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), #ssl_options{}) -> - {[tls_handshake()], binary()}. + {[{tls_handshake(), binary()}], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects %% and returns it as a list of handshake messages, also returns leftover @@ -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 0efedf3400..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), @@ -1323,7 +1323,9 @@ get_signature_scheme_list(#signature_algorithms_cert{ ClientSignatureSchemes; get_signature_scheme_list(#signature_algorithms{ signature_scheme_list = ClientSignatureSchemes}) -> - ClientSignatureSchemes. + %% Filter unassigned and legacy elements + lists:filter(fun (E) -> is_atom(E) andalso E =/= unassigned end, + ClientSignatureSchemes). get_supported_groups(#supported_groups{supported_groups = Groups}) -> Groups. 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/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index f103f3218b..27cd5765e5 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -501,18 +501,18 @@ suites(3) -> suites(4) -> [?TLS_AES_256_GCM_SHA384, ?TLS_AES_128_GCM_SHA256, - ?TLS_CHACHA20_POLY1305_SHA256 + ?TLS_CHACHA20_POLY1305_SHA256, + ?TLS_AES_128_CCM_SHA256 %% Not supported - %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 ] ++ suites(3); suites('TLS_v1.3') -> [?TLS_AES_256_GCM_SHA384, ?TLS_AES_128_GCM_SHA256, - ?TLS_CHACHA20_POLY1305_SHA256 + ?TLS_CHACHA20_POLY1305_SHA256, + ?TLS_AES_128_CCM_SHA256 %% Not supported - %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 ]. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index f7fae16088..dba90aaff0 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -44,6 +44,7 @@ MODULES = \ ssl_bench_SUITE \ ssl_cipher_SUITE \ ssl_cipher_suite_SUITE \ + openssl_server_cipher_suite_SUITE\ ssl_certificate_verify_SUITE\ ssl_crl_SUITE\ ssl_dist_SUITE \ diff --git a/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl b/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl new file mode 100644 index 0000000000..6ce34ce7fa --- /dev/null +++ b/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl @@ -0,0 +1,774 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-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. +%% 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(openssl_server_cipher_suite_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [ + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} + ]. + +groups() -> + %% TODO: Enable SRP, PSK suites (needs OpenSSL s_server conf) + %% TODO: Enable all "kex" on DTLS + [ + {'tlsv1.2', [], kex()}, + {'tlsv1.1', [], kex()}, + {'tlsv1', [], kex()}, + {'sslv3', [], kex()}, + {'dtlsv1.2', [], dtls_kex()}, + {'dtlsv1', [], dtls_kex()}, + {dhe_rsa, [],[dhe_rsa_3des_ede_cbc, + dhe_rsa_aes_128_cbc, + dhe_rsa_aes_256_cbc, + dhe_rsa_chacha20_poly1305 + ]}, + {ecdhe_rsa, [], [ecdhe_rsa_3des_ede_cbc, + ecdhe_rsa_aes_128_cbc, + ecdhe_rsa_aes_128_gcm, + ecdhe_rsa_aes_256_cbc, + ecdhe_rsa_aes_256_gcm, + ecdhe_rsa_chacha20_poly1305 + ]}, + {ecdhe_ecdsa, [],[ecdhe_ecdsa_rc4_128, + ecdhe_ecdsa_3des_ede_cbc, + ecdhe_ecdsa_aes_128_cbc, + ecdhe_ecdsa_aes_128_gcm, + ecdhe_ecdsa_aes_256_cbc, + ecdhe_ecdsa_aes_256_gcm, + ecdhe_ecdsa_chacha20_poly1305 + ]}, + {rsa, [], [rsa_3des_ede_cbc, + rsa_aes_128_cbc, + rsa_aes_256_cbc, + rsa_rc4_128 + ]}, + {dhe_dss, [], [dhe_dss_3des_ede_cbc, + dhe_dss_aes_128_cbc, + dhe_dss_aes_256_cbc]}, + %% {srp_rsa, [], [srp_rsa_3des_ede_cbc, + %% srp_rsa_aes_128_cbc, + %% srp_rsa_aes_256_cbc]}, + %% {srp_dss, [], [srp_dss_3des_ede_cbc, + %% srp_dss_aes_128_cbc, + %% srp_dss_aes_256_cbc]}, + %% {rsa_psk, [], [rsa_psk_3des_ede_cbc, + %% rsa_psk_rc4_128, + %% rsa_psk_aes_128_cbc, + %% rsa_psk_aes_256_cbc + %% ]}, + {dh_anon, [], [dh_anon_rc4_128, + dh_anon_3des_ede_cbc, + dh_anon_aes_128_cbc, + dh_anon_aes_128_gcm, + dh_anon_aes_256_cbc, + dh_anon_aes_256_gcm]}, + {ecdh_anon, [], [ecdh_anon_3des_ede_cbc, + ecdh_anon_aes_128_cbc, + ecdh_anon_aes_256_cbc + ]} + %% {srp_anon, [], [srp_anon_3des_ede_cbc, + %% srp_anon_aes_128_cbc, + %% srp_anon_aes_256_cbc]}, + %% {psk, [], [psk_3des_ede_cbc, + %% psk_rc4_128, + %% psk_aes_128_cbc, + %% psk_aes_128_ccm, + %% psk_aes_128_ccm_8, + %% psk_aes_256_cbc, + %% psk_aes_256_ccm, + %% psk_aes_256_ccm_8 + %% ]}, + %% {dhe_psk, [], [dhe_psk_3des_ede_cbc, + %% dhe_psk_rc4_128, + %% dhe_psk_aes_128_cbc, + %% dhe_psk_aes_128_ccm, + %% dhe_psk_aes_128_ccm_8, + %% dhe_psk_aes_256_cbc, + %% dhe_psk_aes_256_ccm, + %% dhe_psk_aes_256_ccm_8 + %% ]}, + %% {ecdhe_psk, [], [ecdhe_psk_3des_ede_cbc, + %% ecdhe_psk_rc4_128, + %% ecdhe_psk_aes_128_cbc, + %% ecdhe_psk_aes_128_ccm, + %% ecdhe_psk_aes_128_ccm_8, + %% ecdhe_psk_aes_256_cbc + %% ]} + ]. + +kex() -> + rsa() ++ ecdsa() ++ dss() ++ anonymous(). + +dtls_kex() -> %% Should be all kex in the future + dtls_rsa() ++ dss() ++ anonymous(). + +rsa() -> + [{group, dhe_rsa}, + {group, ecdhe_rsa}, + {group, rsa} %%, {group, srp_rsa}, + %%{group, rsa_psk} + ]. + +dtls_rsa() -> + [ + {group, rsa} + %%,{group, rsa_psk} + ]. + +ecdsa() -> + [{group, ecdhe_ecdsa}]. + +dss() -> + [{group, dhe_dss} + %%{group, srp_dss} + ]. + +anonymous() -> + [{group, dh_anon}, + {group, ecdh_anon} + %% {group, psk}, + %%{group, dhe_psk}, + %%{group, ecdhe_psk} + %%{group, srp_anon} + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl_test_lib:clean_start(), + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:supports_ssl_tls_version(GroupName) of + true -> + case ssl_test_lib:check_sane_openssl_version(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName, Config), + do_init_per_group(GroupName, Config); + false -> + {skip, openssl_does_not_support_version} + end; + false -> + {skip, {openssl_does_not_support, GroupName}} + end; + false -> + do_init_per_group(GroupName, Config) + end. + +do_init_per_group(GroupName, Config) when GroupName == ecdh_anon; + GroupName == ecdhe_rsa; + GroupName == ecdhe_psk -> + case proplists:get_bool(ecdh, proplists:get_value(public_keys, crypto:supports())) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing EC crypto support"} + end; +do_init_per_group(ecdhe_ecdsa = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(ecdh, PKAlg) andalso lists:member(ecdsa, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing EC crypto support"} + end; +do_init_per_group(dhe_dss = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dss, PKAlg) andalso lists:member(dh, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing DSS crypto support"} + end; +do_init_per_group(srp_dss = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dss, PKAlg) andalso lists:member(srp, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing DSS_SRP crypto support"} + end; +do_init_per_group(GroupName, Config) when GroupName == srp_anon; + GroupName == srp_rsa -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(srp, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing SRP crypto support"} + end; +do_init_per_group(dhe_psk = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dh, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing SRP crypto support"} + end; +do_init_per_group(GroupName, Config0) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName, end_per_group(GroupName, Config0)); + false -> + init_certs(GroupName, Config0) + end. + +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. + +init_per_testcase(TestCase, Config) when TestCase == psk_3des_ede_cbc; + TestCase == srp_anon_3des_ede_cbc; + TestCase == dhe_psk_3des_ede_cbc; + TestCase == ecdhe_psk_3des_ede_cbc; + TestCase == srp_rsa_3des_ede_cbc; + TestCase == srp_dss_3des_ede_cbc; + TestCase == rsa_psk_3des_ede_cbc; + TestCase == rsa_3des_ede_cbc; + TestCase == dhe_rsa_3des_ede_cbc; + TestCase == dhe_dss_3des_ede_cbc; + TestCase == ecdhe_rsa_3des_ede_cbc; + TestCase == srp_anon_dss_3des_ede_cbc; + TestCase == dh_anon_3des_ede_cbc; + TestCase == ecdh_anon_3des_ede_cbc; + TestCase == ecdhe_ecdsa_3des_ede_cbc -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(des_ede3, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing 3DES crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128; + TestCase == ecdhe_psk_rc4_128; + TestCase == dhe_psk_rc4_128; + TestCase == rsa_psk_rc4_128; + TestCase == rsa_rc4_128; + TestCase == ecdhe_rsa_rc4_128; + TestCase == ecdhe_ecdsa_rc4_128; + TestCase == dh_anon_rc4_128 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(rc4, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing RC4 crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_aes_128_ccm_8; + TestCase == rsa_psk_aes_128_ccm_8; + TestCase == psk_aes_128_ccm_8; + TestCase == dhe_psk_aes_128_ccm_8; + TestCase == ecdhe_psk_aes_128_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_128_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_128_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8; + TestCase == rsa_psk_aes_256_ccm_8; + TestCase == psk_aes_256_ccm_8; + TestCase == dhe_psk_aes_256_ccm_8; + TestCase == ecdhe_psk_aes_256_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_256_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_256_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) -> + Cipher = ssl_test_lib:test_cipher(TestCase, Config), + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(Cipher, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, {Cipher, SupCiphers}} + end. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Initializtion ------------------------------------------ +%%-------------------------------------------------------------------- +init_certs(srp_rsa, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], + client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(srp_anon, Config) -> + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], + client_config => [{srp_identity, {"Test-User", "secret"}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(rsa_psk, Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, + [[ssl_test_lib:digest()],[ssl_test_lib:digest()], + [ssl_test_lib:digest(), {extensions, Ext}]]}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, "_peer_keyEncipherment"), + PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ServerOpts], + client_config => [{psk_identity, "Test-User"}, + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(rsa, Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, + [[ssl_test_lib:digest()],[ssl_test_lib:digest()], + [ssl_test_lib:digest(), {extensions, Ext}]]} + ], + Config, "_peer_keyEncipherment"), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(dhe_dss, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_dsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(srp_dss, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_dsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], + client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == dhe_rsa; + GroupName == ecdhe_rsa -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == dhe_ecdsa; + GroupName == ecdhe_ecdsa -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_ecc_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == psk; + GroupName == dhe_psk; + GroupName == ecdhe_psk -> + PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}], + client_config => [{psk_identity, "Test-User"}, + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(srp, Config) -> + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], + client_config => [{srp_identity, {"Test-User", "secret"}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(_GroupName, Config) -> + %% Anonymous does not need certs + [{tls_config, #{server_config => [], + client_config => []}} | + proplists:delete(tls_config, Config)]. +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% SRP -------------------------------------------------------- +%%-------------------------------------------------------------------- +srp_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, '3des_ede_cbc', Config). + +srp_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, 'aes_128_cbc', Config). + +srp_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, 'aes_256_cbc', Config). + +srp_dss_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, '3des_ede_cbc', Config). + +srp_dss_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, 'aes_128_cbc', Config). + +srp_dss_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, 'aes_256_cbc', Config). + +%%-------------------------------------------------------------------- +%% PSK -------------------------------------------------------- +%%-------------------------------------------------------------------- +rsa_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, '3des_ede_cbc', Config). + +rsa_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_cbc', Config). + +rsa_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_ccm', Config). + +rsa_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_ccm_8', Config). + +rsa_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_cbc', Config). + +rsa_psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_ccm', Config). + +rsa_psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_ccm_8', Config). + +rsa_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'rc4_128', Config). + +%%-------------------------------------------------------------------- +%% RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +rsa_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'des_cbc', Config). + +rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, '3des_ede_cbc', Config). + +rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_128_cbc', Config). + +rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_256_cbc', Config). + +rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_128_gcm', Config). + +rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_256_gcm', Config). + +rsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'rc4_128', Config). +%%-------------------------------------------------------------------- +%% DHE_RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +dhe_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, '3des_ede_cbc', Config). + +dhe_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_128_cbc', Config). + +dhe_rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_128_gcm', Config). + +dhe_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_256_cbc', Config). + +dhe_rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config). + +dhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'chacha20_poly1305', Config). +%%-------------------------------------------------------------------- +%% ECDHE_RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +ecdhe_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, '3des_ede_cbc', Config). + +ecdhe_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_128_cbc', Config). + +ecdhe_rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_128_gcm', Config). + +ecdhe_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_256_cbc', Config). + +ecdhe_rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_256_gcm', Config). + +ecdhe_rsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'rc4_128', Config). + +ecdhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'chacha20_poly1305', Config). + +%%-------------------------------------------------------------------- +%% ECDHE_ECDSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +ecdhe_ecdsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'rc4_128', Config). + +ecdhe_ecdsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, '3des_ede_cbc', Config). + +ecdhe_ecdsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_cbc', Config). + +ecdhe_ecdsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_gcm', Config). + +ecdhe_ecdsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_cbc', Config). + +ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_gcm', Config). + +ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config). +%%-------------------------------------------------------------------- +%% DHE_DSS -------------------------------------------------------- +%%-------------------------------------------------------------------- +dhe_dss_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'des_cbc', Config). + +dhe_dss_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, '3des_ede_cbc', Config). + +dhe_dss_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_128_cbc', Config). + +dhe_dss_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_256_cbc', Config). + +dhe_dss_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_128_gcm', Config). + +dhe_dss_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_256_gcm', Config). + +%%-------------------------------------------------------------------- +%% Anonymous -------------------------------------------------------- +%%-------------------------------------------------------------------- +dh_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, '3des_ede_cbc', Config). + +dh_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_128_cbc', Config). + +dh_anon_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_128_gcm', Config). + +dh_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_256_cbc', Config). + +dh_anon_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_256_gcm', Config). + +dh_anon_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'rc4_128', Config). + +ecdh_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, '3des_ede_cbc', Config). + +ecdh_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, 'aes_128_cbc', Config). + +ecdh_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, 'aes_256_cbc', Config). + +srp_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, '3des_ede_cbc', Config). + +srp_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_128_cbc', Config). + +srp_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_256_cbc', Config). + +dhe_psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'des_cbc', Config). + +dhe_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'rc4_128', Config). + +dhe_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, '3des_ede_cbc', Config). + +dhe_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_cbc', Config). + +dhe_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_cbc', Config). + +dhe_psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_gcm', Config). + +dhe_psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_gcm', Config). + +dhe_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_ccm', Config). + +dhe_psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_ccm', Config). + +dhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_ccm_8', Config). + +dhe_psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_ccm_8', Config). + +ecdhe_psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'des_cbc', Config). + +ecdhe_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'rc4_128', Config). + +ecdhe_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, '3des_ede_cbc', Config). + +ecdhe_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_cbc', Config). + +ecdhe_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_cbc', Config). + +ecdhe_psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_gcm', Config). + +ecdhe_psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_gcm', Config). + +ecdhe_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm', Config). + +ecdhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm_8', Config). + +psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'des_cbc', Config). + +psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(psk, 'rc4_128', Config). + +psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, '3des_ede_cbc', Config). + +psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_cbc', Config). + +psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_cbc', Config). + +psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_gcm', Config). + +psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_gcm', Config). + +psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_ccm', Config). + +psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_ccm', Config). + +psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_ccm_8', Config). + +psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_ccm_8', Config). + +%%-------------------------------------------------------------------- +%% Internal functions ---------------------------------------------- +%%-------------------------------------------------------------------- +run_ciphers_test(Kex, Cipher, Config) -> + Version = ssl_test_lib:protocol_version(Config), + TestCiphers = test_ciphers(Kex, Cipher, Version), + + case TestCiphers of + [_|_] -> + lists:foreach(fun(TestCipher) -> + cipher_suite_test(TestCipher, Version, Config) + end, TestCiphers); + [] -> + {skip, {not_sup, Kex, Cipher, Version}} + end. + +cipher_suite_test(CipherSuite, _Version, Config) -> + #{server_config := SOpts, + client_config := COpts} = proplists:get_value(tls_config, Config), + ServerOpts = ssl_test_lib:ssl_options(SOpts, Config), + ClientOpts = ssl_test_lib:ssl_options(COpts, Config), + ct:log("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Server Opts ~p~n", [ServerOpts]), + ct:log("Client Opts ~p~n", [ClientOpts]), + ssl_test_lib:basic_test([{ciphers, [CipherSuite]} | COpts], SOpts, [{client_type, erlang}, + {server_type, openssl} | Config]). + + +test_ciphers(Kex, Cipher, Version) -> + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, Version) ++ ssl:cipher_suites(anonymous, Version), + [{key_exchange, + fun(Kex0) when Kex0 == Kex -> true; + (_) -> false + end}, + {cipher, + fun(Cipher0) when Cipher0 == Cipher -> true; + (_) -> false + end}]), + ct:log("Version ~p Testing ~p~n", [Version, Ciphers]), + OpenSSLCiphers = openssl_ciphers(), + ct:log("OpenSSLCiphers ~p~n", [OpenSSLCiphers]), + lists:filter(fun(C) -> + ct:log("Cipher ~p~n", [C]), + lists:member(ssl_cipher_format:suite_map_to_openssl_str(C), OpenSSLCiphers) + end, Ciphers). + + +openssl_ciphers() -> + Str = os:cmd("openssl ciphers"), + string:split(string:strip(Str, right, $\n), ":", all). diff --git a/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl new file mode 100644 index 0000000000..f225065ba6 --- /dev/null +++ b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl @@ -0,0 +1,96 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssl_eqc_cipher_format). + +-compile(export_all). + +-proptest(eqc). +-proptest([triq,proper]). + +-ifndef(EQC). +-ifndef(PROPER). +-ifndef(TRIQ). +-define(EQC,true). +-endif. +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). + +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-else. +-ifdef(TRIQ). +-define(MOD_eqc,triq). +-include_lib("triq/include/triq.hrl"). + +-endif. +-endif. +-endif. + +-define('TLS_v1.3', 'tlsv1.3'). +-define('TLS_v1.2', 'tlsv1.2'). +-define('TLS_v1.1', 'tlsv1.1'). +-define('TLS_v1', 'tlsv1'). +-define('SSL_v3', 'sslv3'). + +%%-------------------------------------------------------------------- +%% Properties -------------------------------------------------------- +%%-------------------------------------------------------------------- + +prop_tls_cipher_suite_rfc_name() -> + ?FORALL({CipherSuite, TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), + case ssl:str_to_suite(ssl:suite_to_str(CipherSuite)) of + CipherSuite -> + true; + _ -> + false + end + ). + +prop_tls_cipher_suite_openssl_name() -> + ?FORALL({CipherSuite, TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), + case ssl:str_to_suite(ssl:suite_to_openssl_str(CipherSuite)) of + CipherSuite -> + true; + _ -> + false + end + ). + + +%%-------------------------------------------------------------------- +%% Generators ----------------------------------------------- +%%-------------------------------------------------------------------- +tls_version() -> + oneof([?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). + +cipher_suite(Version) -> + oneof(cipher_suites(Version)). + +cipher_suites(Version) -> + ssl:cipher_suites(all, Version). + diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index ca8d0ec70c..d02888793c 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -51,35 +51,7 @@ groups() -> ]. test_cases()-> - key_cert_combinations() - ++ misc() - ++ ecc_negotiation(). - -key_cert_combinations() -> - server_ecdh_rsa() ++ - server_ecdhe_rsa() ++ - server_ecdh_ecdsa() ++ - server_ecdhe_ecdsa(). - -server_ecdh_rsa() -> - [client_ecdh_rsa_server_ecdh_rsa, - client_ecdhe_rsa_server_ecdh_rsa, - client_ecdhe_ecdsa_server_ecdh_rsa]. - -server_ecdhe_rsa() -> - [client_ecdh_rsa_server_ecdhe_rsa, - client_ecdhe_rsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_rsa]. - -server_ecdh_ecdsa() -> - [client_ecdh_ecdsa_server_ecdh_ecdsa, - client_ecdhe_rsa_server_ecdh_ecdsa, - client_ecdhe_ecdsa_server_ecdh_ecdsa]. - -server_ecdhe_ecdsa() -> - [client_ecdh_rsa_server_ecdhe_ecdsa, - client_ecdh_ecdsa_server_ecdhe_ecdsa, - client_ecdhe_ecdsa_server_ecdhe_ecdsa]. + misc() ++ ecc_negotiation(). misc()-> [client_ecdsa_server_ecdsa_with_raw_key]. @@ -160,35 +132,6 @@ end_per_testcase(_TestCase, Config) -> %% Test diffrent certificate chain types, note that it is the servers %% chain that affect what cipher suit that will be choosen -%% ECDH_RSA -client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config). -client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config). -client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config). -%% ECDHE_RSA -client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config). -client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config). -client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config). -%% ECDH_ECDSA -client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config). -client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config). -%% ECDHE_ECDSA -client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config). -client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config). - client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, @@ -212,7 +155,7 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> ecc_default_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -227,7 +170,7 @@ ecc_default_order(Config) -> ecc_default_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -242,7 +185,7 @@ ecc_default_order_custom_curves(Config) -> ecc_client_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -257,7 +200,7 @@ ecc_client_order(Config) -> ecc_client_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -282,7 +225,7 @@ ecc_unknown_curve(Config) -> client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_ecdsa, Config), @@ -296,7 +239,7 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_rsa, Config), @@ -311,7 +254,7 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), @@ -325,7 +268,7 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_rsa, Config), @@ -339,7 +282,7 @@ client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> end. client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, Default}], @@ -357,7 +300,7 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), @@ -371,7 +314,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_rsa, Config), @@ -385,7 +328,7 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), @@ -399,7 +342,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), diff --git a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl index 81a7dfd2da..68d4e910fd 100644 --- a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl @@ -33,77 +33,23 @@ %%-------------------------------------------------------------------- all() -> - case test_cases() of - [_|_] -> - all_groups(); - [] -> - [skip] - end. - -all_groups() -> case ssl_test_lib:openssl_sane_dtls() of true -> [{group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'dtlsv1.2'}, - {group, 'dtlsv1'}]; + {group, 'dtlsv1.2'}]; false -> - [{group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}] + [{group, 'tlsv1.2'}] end. groups() -> case ssl_test_lib:openssl_sane_dtls() of true -> - [{'tlsv1.2', [], [mix_sign | test_cases()]}, - {'tlsv1.1', [], test_cases()}, - {'tlsv1', [], test_cases()}, - {'dtlsv1.2', [], [mix_sign | test_cases()]}, - {'dtlsv1', [], test_cases()}]; + [{'tlsv1.2', [], [mix_sign]}, + {'dtlsv1.2', [], [mix_sign]}]; false -> - [{'tlsv1.2', [], [mix_sign | test_cases()]}, - {'tlsv1.1', [], test_cases()}, - {'tlsv1', [], test_cases()}] + [{'tlsv1.2', [], [mix_sign]}] end. - -test_cases()-> - cert_combinations(). -cert_combinations() -> - lists:append(lists:map(fun({Name, Suites}) -> - case ssl_test_lib:openssl_filter(Name) of - [] -> - []; - [_|_] -> - Suites - end - end, [{"ECDH-ECDSA", server_ecdh_ecdsa()}, - {"ECDH-RSA", server_ecdh_rsa()}, - {"ECDHE-RSA", server_ecdhe_rsa()}, - {"ECDHE-ECDSA", server_ecdhe_ecdsa()} - ])). -server_ecdh_rsa() -> - [client_ecdh_rsa_server_ecdh_rsa, - client_ecdhe_rsa_server_ecdh_rsa, - client_ecdhe_ecdsa_server_ecdh_rsa]. - -server_ecdhe_rsa() -> - [client_ecdh_rsa_server_ecdhe_rsa, - client_ecdhe_rsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_rsa]. - -server_ecdh_ecdsa() -> - [client_ecdh_ecdsa_server_ecdh_ecdsa, - client_ecdhe_rsa_server_ecdh_ecdsa, - client_ecdhe_ecdsa_server_ecdh_ecdsa]. - -server_ecdhe_ecdsa() -> - [client_ecdh_rsa_server_ecdhe_ecdsa, - client_ecdh_ecdsa_server_ecdhe_ecdsa, - client_ecdhe_ecdsa_server_ecdhe_ecdsa]. - %%-------------------------------------------------------------------- init_per_suite(Config0) -> end_per_suite(Config0), @@ -171,38 +117,6 @@ end_per_testcase(_TestCase, Config) -> skip(Config) when is_list(Config) -> {skip, openssl_does_not_support_ECC}. -%% Test diffrent certificate chain types, note that it is the servers -%% chain that affect what cipher suit that will be choosen - -%% ECDH_RSA -client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config). -client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config). -client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config). -%% ECDHE_RSA -client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config). -client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config). -client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config). -%% ECDH_ECDSA -client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config). -client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config). -%% ECDHE_ECDSA -client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config). -client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config). - mix_sign(Config) -> {COpts0, SOpts0} = ssl_test_lib:make_mix_cert(Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 03ee97de5d..20d9f28512 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -549,11 +549,10 @@ alerts(Config) when is_list(Config) -> Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], lists:foreach(fun(Alert) -> - case ssl_alert:alert_txt(Alert) of - Txt when is_list(Txt) -> - ok; - Other -> - ct:fail({unexpected, Other}) + try ssl_alert:alert_txt(Alert) + catch + C:E:T -> + ct:fail({unexpected, {C, E, T}}) end end, Alerts). %%-------------------------------------------------------------------- @@ -1833,14 +1832,12 @@ eccs() -> eccs(Config) when is_list(Config) -> [_|_] = All = ssl:eccs(), - [] = SSL3 = ssl:eccs({3,0}), - [_|_] = Tls = ssl:eccs({3,1}), - [_|_] = Tls1 = ssl:eccs({3,2}), - [_|_] = Tls2 = ssl:eccs({3,3}), [] = SSL3 = ssl:eccs(sslv3), [_|_] = Tls = ssl:eccs(tlsv1), [_|_] = Tls1 = ssl:eccs('tlsv1.1'), [_|_] = Tls2 = ssl:eccs('tlsv1.2'), + [_|_] = Tls1 = ssl:eccs('dtlsv1'), + [_|_] = Tls2 = ssl:eccs('dtlsv1.2'), %% ordering is currently unverified by the test true = lists:sort(All) =:= lists:usort(SSL3 ++ Tls ++ Tls1 ++ Tls2), ok. @@ -2775,8 +2772,8 @@ make_sure_expired(Host, Port, Id) -> server_does_not_want_to_reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. server_does_not_want_to_reuse_session(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -3655,7 +3652,7 @@ listen_socket(Config) -> {error, enotconn} = ssl:peername(ListenSocket), {error, enotconn} = ssl:peercert(ListenSocket), {error, enotconn} = ssl:renegotiate(ListenSocket), - {error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, client_random, 256), + {error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, [client_random], 256), {error, enotconn} = ssl:shutdown(ListenSocket, read_write), ok = ssl:close(ListenSocket). diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 4f340af4f5..55dee9a48f 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -448,7 +448,7 @@ server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> [{_,_,_}, {_, IntermidiateCA, _} | _] = public_key:pem_decode(ServerCAs), PartialChain = fun(_CertChain) -> - ture = false %% crash on purpose + true = false %% crash on purpose end, Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl index bf1bc0e752..51788c29e7 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -127,7 +127,6 @@ groups() -> ]} ]. - kex() -> rsa() ++ ecdsa() ++ dss() ++ anonymous(). @@ -154,7 +153,6 @@ anonymous() -> {group, ecdhe_psk}, {group, srp_anon} ]. - init_per_suite(Config) -> catch crypto:stop(), @@ -170,7 +168,7 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -%%-------------------------------------------------------------------- + init_per_group(GroupName, Config) when GroupName == ecdh_anon; GroupName == ecdhe_rsa; GroupName == ecdhe_psk -> @@ -236,6 +234,7 @@ end_per_group(GroupName, Config) -> false -> Config end. + init_per_testcase(TestCase, Config) when TestCase == psk_3des_ede_cbc; TestCase == srp_anon_3des_ede_cbc; TestCase == dhe_psk_3des_ede_cbc; @@ -302,8 +301,7 @@ init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8; {skip, "Missing AES_256_CCM crypto support"} end; init_per_testcase(TestCase, Config) -> - Cipher = test_cipher(TestCase, Config), - %%Reason = io_lib:format("Missing ~p crypto support", [Cipher]), + Cipher = ssl_test_lib:test_cipher(TestCase, Config), SupCiphers = proplists:get_value(ciphers, crypto:supports()), case lists:member(Cipher, SupCiphers) of true -> @@ -316,17 +314,21 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(_TestCase, Config) -> Config. +%%-------------------------------------------------------------------- +%% Initializtion ------------------------------------------ +%%-------------------------------------------------------------------- + init_certs(srp_rsa, Config) -> DefConf = ssl_test_lib:default_cert_chain_conf(), CertChainConf = ssl_test_lib:gen_conf(rsa, rsa, DefConf, DefConf), #{server_config := ServerOpts, client_config := ClientOpts} = public_key:pkix_test_data(CertChainConf), - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; init_certs(srp_anon, Config) -> - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}}], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], client_config => [{srp_identity, {"Test-User", "secret"}}]}} | proplists:delete(tls_config, Config)]; init_certs(rsa_psk, Config) -> @@ -335,9 +337,9 @@ init_certs(rsa_psk, Config) -> [[],[],[{extensions, ClientExt}]]}], Config, "_peer_keyEncipherment"), PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ServerOpts], client_config => [{psk_identity, "Test-User"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}} | ClientOpts]}} | + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; init_certs(rsa, Config) -> ClientExt = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), @@ -362,7 +364,7 @@ init_certs(srp_dss, Config) -> #{server_config := ServerOpts, client_config := ClientOpts} = public_key:pkix_test_data(CertChainConf), - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; init_certs(GroupName, Config) when GroupName == dhe_rsa; @@ -389,12 +391,12 @@ init_certs(GroupName, Config) when GroupName == psk; GroupName == dhe_psk; GroupName == ecdhe_psk -> PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}], client_config => [{psk_identity, "Test-User"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}} | + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}]}} | proplists:delete(tls_config, Config)]; init_certs(srp, Config) -> - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}}], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], client_config => [{srp_identity, {"Test-User", "secret"}}]}} | proplists:delete(tls_config, Config)]; init_certs(_GroupName, Config) -> @@ -402,6 +404,7 @@ init_certs(_GroupName, Config) -> [{tls_config, #{server_config => [], client_config => []}} | proplists:delete(tls_config, Config)]. + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -700,10 +703,6 @@ psk_aes_256_ccm_8(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Internal functions ---------------------------------------------- %%-------------------------------------------------------------------- -test_cipher(TestCase, Config) -> - [{name, Group} |_] = proplists:get_value(tc_group_properties, Config), - list_to_atom(re:replace(atom_to_list(TestCase), atom_to_list(Group) ++ "_", "", [{return, list}])). - run_ciphers_test(Kex, Cipher, Config) -> Version = ssl_test_lib:protocol_version(Config), TestCiphers = test_ciphers(Kex, Cipher, Version), @@ -717,30 +716,28 @@ run_ciphers_test(Kex, Cipher, Config) -> {skip, {not_sup, Kex, Cipher, Version}} end. -cipher_suite_test(CipherSuite, Version, Config) -> +cipher_suite_test(ErlangCipherSuite, Version, Config) -> #{server_config := SOpts, client_config := COpts} = proplists:get_value(tls_config, Config), ServerOpts = ssl_test_lib:ssl_options(SOpts, Config), ClientOpts = ssl_test_lib:ssl_options(COpts, Config), - ct:log("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Testing CipherSuite ~p~n", [ErlangCipherSuite]), ct:log("Server Opts ~p~n", [ServerOpts]), ct:log("Client Opts ~p~n", [ClientOpts]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - ErlangCipherSuite = erlang_cipher_suite(CipherSuite), - ConnectionInfo = {ok, {Version, ErlangCipherSuite}}, Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, [{versions, [Version]}, {ciphers, [CipherSuite]} | ServerOpts]}]), + {options, [{versions, [Version]}, {ciphers, [ErlangCipherSuite]} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, [{versions, [Version]}, {ciphers, [CipherSuite]} | + {options, [{versions, [Version]}, {ciphers, [ErlangCipherSuite]} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -748,17 +745,6 @@ cipher_suite_test(CipherSuite, Version, Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). -erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite)); -erlang_cipher_suite(Suite) -> - Suite. - -user_lookup(psk, _Identity, UserState) -> - {ok, UserState}; -user_lookup(srp, Username, _UserState) -> - Salt = ssl_cipher:random_bytes(16), - UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), - {ok, {srp_1024, Salt, UserPassHash}}. test_ciphers(Kex, Cipher, Version) -> ssl:filter_cipher_suites(ssl:cipher_suites(all, Version) ++ ssl:cipher_suites(anonymous, Version), @@ -770,3 +756,4 @@ test_ciphers(Kex, Cipher, Version) -> fun(Cipher0) when Cipher0 == Cipher -> true; (_) -> false end}]). + diff --git a/lib/ssl/test/ssl_eqc_SUITE.erl b/lib/ssl/test/ssl_eqc_SUITE.erl index bd36d35c02..bfdb1a3d54 100644 --- a/lib/ssl/test/ssl_eqc_SUITE.erl +++ b/lib/ssl/test/ssl_eqc_SUITE.erl @@ -27,7 +27,9 @@ all() -> [ - tls_handshake_encoding + tls_handshake_encoding, + tls_cipher_suite_names, + tls_cipher_openssl_suite_names ]. %%-------------------------------------------------------------------- @@ -56,3 +58,13 @@ tls_handshake_encoding(Config) when is_list(Config) -> %% manual test: proper:quickcheck(ssl_eqc_handshake:prop_tls_hs_encode_decode()). true = ct_property_test:quickcheck(ssl_eqc_handshake:prop_tls_hs_encode_decode(), Config). + +tls_cipher_suite_names(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(ssl_eqc_cipher_format:prop_tls_cipher_suite_rfc_name()). + true = ct_property_test:quickcheck(ssl_eqc_cipher_format:prop_tls_cipher_suite_rfc_name(), + Config). + +tls_cipher_openssl_suite_names(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(ssl_eqc_handshake:prop_tls_cipher_suite_openssl_name()). + true = ct_property_test:quickcheck(ssl_eqc_cipher_format:prop_tls_cipher_suite_openssl_name(), + Config). diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 7f33fe3204..b71b15b028 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -186,7 +186,7 @@ session_cleanup() -> session_cleanup(Config) when is_list(Config) -> process_flag(trap_exit, true), ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 22169035f3..3b161a0c8a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -51,20 +51,20 @@ node_to_hostip(Node) -> Address. start_server(Args) -> - Result = spawn_link(?MODULE, run_server, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_server, [Args]), receive {listen, up} -> Result end. run_server(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), run_server(ListenSocket, Opts). @@ -90,13 +90,12 @@ do_run_server(_, ok = Result, Opts) -> Pid = proplists:get_value(from, Opts), Pid ! {self(), Result}; do_run_server(ListenSocket, AcceptSocket, Opts) -> - Node = proplists:get_value(node, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nServer: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]), - case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of + case apply(Module, Function, [AcceptSocket | Args]) of no_result_msg -> ok; Msg -> @@ -110,8 +109,8 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]); close -> ct:log("~p:~p~nServer closing ~p ~n", [?MODULE,?LINE, self()]), - Result = rpc:call(Node, Transport, close, [AcceptSocket], 500), - Result1 = rpc:call(Node, Transport, close, [ListenSocket], 500), + Result = Transport:close(AcceptSocket), + Result1 = Transport:close(ListenSocket), ct:log("~p:~p~nResult ~p : ~p ~n", [?MODULE,?LINE, Result, Result1]); {ssl_closed, _} -> ok @@ -132,41 +131,37 @@ connect(#sslsocket{} = ListenSocket, Opts) -> remove_close_msg(ReconnectTimes), AcceptSocket end; -connect(ListenSocket, Opts) -> - Node = proplists:get_value(node, Opts), +connect(ListenSocket, _Opts) -> ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, - [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), AcceptSocket. connect(_, _, 0, AcceptSocket, _, _, _) -> AcceptSocket; connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), - case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + case ssl:handshake(AcceptSocket, SslOpts, Timeout) of {ok, Socket0, Ext} -> ct:log("Ext ~p:~n", [Ext]), ct:log("~p:~p~nssl:handshake_cancel(~p)~n", [?MODULE,?LINE, Socket0]), - rpc:call(Node, ssl, handshake_cancel, [Socket0]); + ssl:handshake_cancel(Socket0); Result -> ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end; connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), - case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + case ssl:handshake(AcceptSocket, SslOpts, Timeout) of {ok, Socket0, Ext} -> ct:log("Ext ~p:~n", [Ext]), ct:log("~p:~p~nssl:handshake_continue(~p,~p,~p)~n", [?MODULE,?LINE, Socket0, ContOpts,Timeout]), - case rpc:call(Node, ssl, handshake_continue, [Socket0, ContOpts, Timeout]) of + case ssl:handshake_continue(Socket0, ContOpts, Timeout) of {ok, Socket} -> connect(ListenSocket, Node, N-1, Socket, Timeout, SslOpts, ContOpts); Error -> @@ -179,35 +174,35 @@ connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) -> end; connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, Timeout]), - case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of - ok -> - connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, [], ContOpts); + case ssl:handshake(AcceptSocket, Timeout) of + {ok, Socket} -> + connect(ListenSocket, Node, N-1, Socket, Timeout, [], ContOpts); Result -> - ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]), + ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end; -connect(ListenSocket, Node, _, _, Timeout, Opts, _) -> +connect(ListenSocket, _Node, _, _, Timeout, Opts, _) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - ct:log("ssl:ssl_accept(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]), - rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Opts, Timeout]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + ct:log("ssl:handshake(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]), + ssl:handshake(AcceptSocket, Opts, Timeout), AcceptSocket. start_server_transport_abuse_socket(Args) -> - Result = spawn_link(?MODULE, transport_accept_abuse, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, transport_accept_abuse, [Args]), receive {listen, up} -> Result end. start_server_transport_control(Args) -> - Result = spawn_link(?MODULE, transport_switch_control, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, transport_switch_control, [Args]), receive {listen, up} -> Result @@ -215,35 +210,31 @@ start_server_transport_control(Args) -> transport_accept_abuse(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - {error, _} = rpc:call(Node, ssl, connection_information, [AcceptSocket]), - _ = rpc:call(Node, ssl, handshake, [AcceptSocket, infinity]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + {error, _} = ssl:connection_information(AcceptSocket), + _ = ssl:handshake(AcceptSocket, infinity), Pid ! {self(), ok}. transport_switch_control(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - ok = rpc:call(Node, ssl, controlling_process, [AcceptSocket, self()]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + ok = ssl:controlling_process(AcceptSocket, self()), Pid ! {self(), ok}. @@ -256,7 +247,8 @@ remove_close_msg(ReconnectTimes) -> end. start_client(Args) -> - Result = spawn_link(?MODULE, run_client_init, [lists:delete(return_socket, Args)]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_client_init, [lists:delete(return_socket, Args)]), receive {connected, Socket} -> case lists:member(return_socket, Args) of @@ -288,8 +280,8 @@ run_client(Opts) -> client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) end. -client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_loop(_Node, Host, Port, Pid, Transport, Options, Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket} -> Pid ! {connected, Socket}, ct:log("~p:~p~nClient: connected~n", [?MODULE,?LINE]), @@ -299,7 +291,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [Socket | Args]]), - case rpc:call(Node, Module, Function, [Socket | Args]) of + case apply(Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> @@ -309,7 +301,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> receive close -> ct:log("~p:~p~nClient closing~n", [?MODULE,?LINE]), - rpc:call(Node, Transport, close, [Socket]); + Transport:close(Socket); {ssl_closed, Socket} -> ok; {gen_tcp, closed} -> @@ -339,16 +331,13 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> end; {error, Reason} -> ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), - Pid ! {connect_failed, Reason}; - {badrpc,BadRPC} -> - ct:log("~p:~p~nBad rpc: ~p",[?MODULE,?LINE, BadRPC]), - Pid ! {connect_failed, {badrpc,BadRPC}} + Pid ! {connect_failed, Reason} end. -client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_cont_loop(_Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket, _} -> - Result = rpc:call(Node, Transport, handshake_cancel, [Socket]), + Result = Transport:handshake_cancel(Socket), ct:log("~p:~p~nClient: Cancel: ~p ~n", [?MODULE,?LINE, Result]), Pid ! {connect_failed, Result}; {error, Reason} -> @@ -356,17 +345,17 @@ client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> Pid ! {connect_failed, Reason} end; -client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_cont_loop(_Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket0, _} -> ct:log("~p:~p~nClient: handshake_continue(~p, ~p, infinity) ~n", [?MODULE, ?LINE, Socket0, ContOpts]), - case rpc:call(Node, Transport, handshake_continue, [Socket0, ContOpts]) of + case Transport:handshake_continue(Socket0, ContOpts) of {ok, Socket} -> Pid ! {connected, Socket}, {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [Socket | Args]]), - case rpc:call(Node, Module, Function, [Socket | Args]) of + case apply(Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> @@ -642,6 +631,40 @@ make_rsa_cert_chains(UserConf, Config, Suffix) -> [{reuseaddr, true}, {verify, verify_peer} | ServerConf] }. +make_ecc_cert_chains(UserConf, Config, Suffix) -> + ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), + ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), + CertChainConf = gen_conf(ecdsa, ecdsa, ClientChain, ServerChain), + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "ecdsa" ++ Suffix]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "ecdsa" ++ Suffix]), + GenCertData = public_key:pkix_test_data(CertChainConf), + [{server_config, ServerConf}, + {client_config, ClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + {[{verify, verify_peer} | ClientConf], + [{reuseaddr, true}, {verify, verify_peer} | ServerConf] + }. + + +make_dsa_cert_chains(UserConf, Config, Suffix) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(dss, proplists:get_value(public_keys, CryptoSupport)) of + true -> + ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), + ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), + CertChainConf = gen_conf(dsa, dsa, ClientChain, ServerChain), + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa" ++ Suffix]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa" ++ Suffix]), + GenCertData = public_key:pkix_test_data(CertChainConf), + [{server_config, ServerConf}, + {client_config, ClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + {[{verify, verify_peer} | ClientConf], + [{reuseaddr, true}, {verify, verify_peer} | ServerConf]}; + false -> + Config + end. + make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config) -> make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, ?DEFAULT_CURVE). %% @@ -896,14 +919,14 @@ make_ecdh_rsa_cert(Config) -> end. start_upgrade_server(Args) -> - Result = spawn_link(?MODULE, run_upgrade_server, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_upgrade_server, [Args]), receive {listen, up} -> Result end. run_upgrade_server(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), TimeOut = proplists:get_value(timeout, Opts, infinity), TcpOptions = proplists:get_value(tcp_options, Opts), @@ -911,43 +934,41 @@ run_upgrade_server(Opts) -> Pid = proplists:get_value(from, Opts), ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), - {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), + {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), try {ok, SslAcceptSocket} = case TimeOut of infinity -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions]); + ssl:handshake(AcceptSocket, SslOptions); _ -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions, TimeOut]) + ssl:handshake(AcceptSocket, SslOptions, TimeOut) end, {Module, Function, Args} = proplists:get_value(mfa, Opts), - Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]), + Msg = apply(Module, Function, [SslAcceptSocket | Args]), ct:log("~p:~p~nUpgrade Server Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> ct:log("~p:~p~nUpgrade Server closing~n", [?MODULE,?LINE]), - rpc:call(Node, ssl, close, [SslAcceptSocket]) + ssl:close(SslAcceptSocket) end catch error:{badmatch, Error} -> Pid ! {self(), Error} end. start_upgrade_client(Args) -> - spawn_link(?MODULE, run_upgrade_client, [Args]). + Node = proplists:get_value(node, Args), + spawn_link(Node, ?MODULE, run_upgrade_client, [Args]). run_upgrade_client(Opts) -> - Node = proplists:get_value(node, Opts), Host = proplists:get_value(host, Opts), Port = proplists:get_value(port, Opts), Pid = proplists:get_value(from, Opts), @@ -956,34 +977,34 @@ run_upgrade_client(Opts) -> ct:log("~p:~p~ngen_tcp:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, TcpOptions]), - {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]), + {ok, Socket} = gen_tcp:connect(Host, Port, TcpOptions), send_selected_port(Pid, Port, Socket), ct:log("~p:~p~nssl:connect(~p, ~p)~n", [?MODULE,?LINE, Socket, SslOptions]), - {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]), + {ok, SslSocket} = ssl:connect(Socket, SslOptions), {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~napply(~p, ~p, ~p)~n", [?MODULE,?LINE, Module, Function, [SslSocket | Args]]), - Msg = rpc:call(Node, Module, Function, [SslSocket | Args]), + Msg = apply(Module, Function, [SslSocket | Args]), ct:log("~p:~p~nUpgrade Client Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> ct:log("~p:~p~nUpgrade Client closing~n", [?MODULE,?LINE]), - rpc:call(Node, ssl, close, [SslSocket]) + ssl:close(SslSocket) end. start_upgrade_server_error(Args) -> - Result = spawn_link(?MODULE, run_upgrade_server_error, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node,?MODULE, run_upgrade_server_error, [Args]), receive {listen, up} -> Result end. run_upgrade_server_error(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), TimeOut = proplists:get_value(timeout, Opts, infinity), TcpOptions = proplists:get_value(tcp_options, Opts), @@ -991,22 +1012,20 @@ run_upgrade_server_error(Opts) -> Pid = proplists:get_value(from, Opts), ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), - {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), + {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), Error = case TimeOut of infinity -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions]); + ssl:handshake(AcceptSocket, SslOptions); _ -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("~p:~p~nssl:ssl_handshake(~p, ~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions, TimeOut]) + ssl:handshake(AcceptSocket, SslOptions, TimeOut) end, Pid ! {self(), Error}. @@ -1018,32 +1037,31 @@ start_server_error(Args) -> end. run_server_error(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - case rpc:call(Node, Transport, listen, [Port, Options]) of + case Transport:listen(Port, Options) of {ok, #sslsocket{} = ListenSocket} -> %% To make sure error_client will %% get {error, closed} and not {error, connection_refused} Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~nssl:transport_accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - case rpc:call(Node, Transport, transport_accept, [ListenSocket]) of + case Transport:transport_accept(ListenSocket) of {error, _} = Error -> Pid ! {self(), Error}; {ok, AcceptSocket} -> ct:log("~p:~p~nssl:ssl_accept(~p)~n", [?MODULE,?LINE, AcceptSocket]), - Error = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]), + Error = ssl:handshake(AcceptSocket), Pid ! {self(), Error} end; {ok, ListenSocket} -> Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~n~p:accept(~p)~n", [?MODULE,?LINE, Transport, ListenSocket]), - case rpc:call(Node, Transport, accept, [ListenSocket]) of + case Transport:accept(ListenSocket) of {error, _} = Error -> Pid ! {self(), Error} end; @@ -1055,17 +1073,17 @@ run_server_error(Opts) -> end. start_client_error(Args) -> - spawn_link(?MODULE, run_client_error, [Args]). + Node = proplists:get_value(node, Args), + spawn_link(Node, ?MODULE, run_client_error, [Args]). run_client_error(Opts) -> - Node = proplists:get_value(node, Opts), Host = proplists:get_value(host, Opts), Port = proplists:get_value(port, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), - Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), + Error = Transport:connect(Host, Port, Options), Pid ! {self(), Error}. accepters(N) -> @@ -1083,7 +1101,7 @@ accepters(Acc, N) -> basic_test(COpts, SOpts, Config) -> SType = proplists:get_value(server_type, Config), CType = proplists:get_value(client_type, Config), - {Server, Port} = start_server(SType, SOpts, Config), + {Server, Port} = start_server(SType, COpts, SOpts, Config), Client = start_client(CType, Port, COpts, Config), gen_check_result(Server, SType, Client, CType), stop(Server, Client). @@ -1150,7 +1168,7 @@ start_client(erlang, Port, ClientOpts, Config) -> {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}}, - {options, [{verify, verify_peer} | ClientOpts]}]). + {options, ClientOpts}]). %% Workaround for running tests on machines where openssl %% s_client would use an IPv6 address with localhost. As @@ -1185,20 +1203,19 @@ start_client_ecc_error(erlang, Port, ClientOpts, ECCOpts, Config) -> [{verify, verify_peer} | ClientOpts]}]). -start_server(openssl, ServerOpts, Config) -> - Cert = proplists:get_value(certfile, ServerOpts), - Key = proplists:get_value(keyfile, ServerOpts), - CA = proplists:get_value(cacertfile, ServerOpts), +start_server(openssl, ClientOpts, ServerOpts, Config) -> Port = inet_port(node()), Version = protocol_version(Config), Exe = "openssl", - Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-verify", "2", "-cert", Cert, "-CAfile", CA, - "-key", Key, "-msg", "-debug"], + CertArgs = openssl_cert_options(ServerOpts), + [Cipher|_] = proplists:get_value(ciphers, ClientOpts, ssl:cipher_suites(default,Version)), + Args = ["s_server", "-accept", integer_to_list(Port), "-cipher", + ssl_cipher_format:suite_map_to_openssl_str(Cipher), + ssl_test_lib:version_flag(Version)] ++ CertArgs ++ ["-msg", "-debug"], OpenSslPort = portable_open_port(Exe, Args), true = port_command(OpenSslPort, "Hello world"), {OpenSslPort, Port}; -start_server(erlang, ServerOpts, Config) -> +start_server(erlang, _, ServerOpts, Config) -> {_, ServerNode, _} = ssl_test_lib:run_where(Config), KeyEx = proplists:get_value(check_keyex, Config, false), Server = start_server([{node, ServerNode}, {port, 0}, @@ -1261,6 +1278,29 @@ stop(Client, Server) -> close(Server), close(Client). + +openssl_cert_options(ServerOpts) -> + Cert = proplists:get_value(certfile, ServerOpts, undefined), + Key = proplists:get_value(keyfile, ServerOpts, undefined), + CA = proplists:get_value(cacertfile, ServerOpts, undefined), + case CA of + undefined -> + case cert_option("-cert", Cert) ++ cert_option("-key", Key) of + [] -> + ["-nocert"]; + Other -> + Other + end; + _ -> + cert_option("-cert", Cert) ++ cert_option("-CAfile", CA) ++ + cert_option("-key", Key) ++ ["-verify", "2"] + end. + +cert_option(_, undefined) -> + []; +cert_option(Opt, Value) -> + [Opt, Value]. + supported_eccs(Opts) -> ToCheck = proplists:get_value(eccs, Opts, []), Supported = ssl:eccs(), @@ -1357,13 +1397,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))]. @@ -1436,7 +1476,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; @@ -1446,7 +1486,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, @@ -1457,7 +1497,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; @@ -1480,7 +1520,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; @@ -1488,10 +1528,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; @@ -1499,14 +1539,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, @@ -1772,6 +1812,15 @@ is_sane_ecc(crypto) -> is_sane_ecc(_) -> sufficient_crypto_support(cipher_ec). +is_sane_oppenssl_client() -> + [{_,_, Bin}] = crypto:info_lib(), + case binary_to_list(Bin) of + "OpenSSL 0.9" ++ _ -> + false; + _ -> + true + end. + is_fips(openssl) -> VersionStr = os:cmd("openssl version"), case re:split(VersionStr, "fips") of @@ -1880,6 +1929,14 @@ check_sane_openssl_version(Version) -> case {Version, os:cmd("openssl version")} of {'sslv3', "OpenSSL 1.0.2" ++ _} -> false; + {'dtlsv1', "OpenSSL 0" ++ _} -> + false; + {'dtlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} -> + false; + {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> + false; {'dtlsv1', _} -> not is_fips(openssl); {'dtlsv1.2', _} -> @@ -1892,18 +1949,10 @@ check_sane_openssl_version(Version) -> false; {'tlsv1.1', "OpenSSL 1.0.0" ++ _} -> false; - {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} -> - false; - {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> - false; {'tlsv1.2', "OpenSSL 0" ++ _} -> false; {'tlsv1.1', "OpenSSL 0" ++ _} -> false; - {'dtlsv1', "OpenSSL 0" ++ _} -> - false; - {'dtlsv1.2', "OpenSSL 0" ++ _} -> - false; {_, _} -> true end; @@ -1948,10 +1997,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), @@ -1963,7 +2012,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"). @@ -2381,3 +2430,16 @@ user_lookup(srp, Username, _UserState) -> Salt = ssl_cipher:random_bytes(16), UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), {ok, {srp_1024, Salt, UserPassHash}}. + +test_cipher(TestCase, Config) -> + [{name, Group} |_] = proplists:get_value(tc_group_properties, Config), + list_to_atom(re:replace(atom_to_list(TestCase), atom_to_list(Group) ++ "_", "", [{return, list}])). + +digest() -> + case application:get_env(ssl, protocol_version, application:get_env(ssl, dtls_protocol_version)) of + Ver when Ver == 'tlsv1.2'; + Ver == 'dtlsv1.2' -> + {digest, sha256}; + _ -> + {digest, sha1} + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index f22eb4ecdf..07abddbcf7 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -181,16 +181,6 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -init_per_group(basic, Config0) -> - case ssl_test_lib:supports_ssl_tls_version('tlsv1.2') - orelse ssl_test_lib:supports_ssl_tls_version('tlsv1.1') - orelse ssl_test_lib:supports_ssl_tls_version('tlsv1') - of - true -> - ssl_test_lib:clean_tls_version(Config0); - false -> - {skip, "only sslv3 supported by OpenSSL"} - end; init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of @@ -233,7 +223,7 @@ init_per_testcase(TestCase, Config) when TestCase == erlang_server_openssl_client_dsa_cert; TestCase == erlang_client_openssl_server_dsa_cert; TestCase == erlang_server_openssl_client_dsa_cert -> - case ssl_test_lib:openssl_dsa_support() of + case ssl_test_lib:openssl_dsa_support() andalso ssl_test_lib:is_sane_oppenssl_client() of true -> special_init(TestCase, Config); false -> @@ -334,7 +324,16 @@ special_init(TestCase, Config0) ]} ]}]} | Config0], check_openssl_sni_support(Config); - +special_init(TestCase, Config) + when TestCase == erlang_server_openssl_client; + TestCase == erlang_server_openssl_client_client_cert; + TestCase == erlang_server_openssl_client_reuse_session -> + case ssl_test_lib:is_sane_oppenssl_client() of + true -> + Config; + false -> + {skip, "Broken OpenSSL client"} + end; special_init(_, Config) -> Config. @@ -1073,7 +1072,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, no_result_msg, []}}, + {mfa, {ssl_test_lib, no_result, []}}, {options, [{versions, [Version]} | ClientOpts]}]), @@ -1161,7 +1160,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), ssl_test_lib:consume_port_exit(OpenSslPort), - ssl_test_lib:check_server_alert(Server, bad_record_mac), + ssl_test_lib:check_server_alert(Server, unexpected_message), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -1462,6 +1461,7 @@ send_and_hostname(SSLSocket) -> end. erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + Version = ssl_test_lib:protocol_version(Config), ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1472,9 +1472,9 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, Exe = "openssl", ClientArgs = case SNIHostname of undefined -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port); + openssl_client_args(Version, Hostname,Port); _ -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname) + openssl_client_args(Version, Hostname, Port, SNIHostname) end, ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), @@ -1485,6 +1485,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + Version = ssl_test_lib:protocol_version(Config), ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), [{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config), SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, @@ -1497,9 +1498,9 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo Exe = "openssl", ClientArgs = case SNIHostname of undefined -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port); + openssl_client_args(Version, Hostname,Port); _ -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname) + openssl_client_args(Version, Hostname, Port, SNIHostname) end, ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), @@ -1910,13 +1911,19 @@ send_wait_send(Socket, [ErlData, OpenSslData]) -> check_openssl_sni_support(Config) -> HelpText = os:cmd("openssl s_client --help"), - case string:str(HelpText, "-servername") of - 0 -> - {skip, "Current openssl doesn't support SNI"}; - _ -> - Config + case ssl_test_lib:is_sane_oppenssl_client() of + true -> + case string:str(HelpText, "-servername") of + 0 -> + {skip, "Current openssl doesn't support SNI"}; + _ -> + Config + end; + false -> + {skip, "Current openssl doesn't support SNI or extension handling is flawed"} end. + check_openssl_npn_support(Config) -> HelpText = os:cmd("openssl s_client --help"), case string:str(HelpText, "nextprotoneg") of @@ -1982,17 +1989,13 @@ workaround_openssl_s_clinent() -> [] end. -openssl_client_args(false, Hostname, Port) -> - ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; -openssl_client_args(true, Hostname, Port) -> - ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]. +openssl_client_args(Version, Hostname, Port) -> + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), ssl_test_lib:version_flag(Version)]. -openssl_client_args(false, Hostname, Port, ServerName) -> +openssl_client_args(Version, Hostname, Port, ServerName) -> ["s_client", "-connect", Hostname ++ ":" ++ - integer_to_list(Port), "-servername", ServerName]; -openssl_client_args(true, Hostname, Port, ServerName) -> - ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++ - integer_to_list(Port), "-servername", ServerName]. + integer_to_list(Port), ssl_test_lib:version_flag(Version), "-servername", ServerName]. + hostname_format(Hostname) -> case lists:member($., Hostname) of @@ -2002,22 +2005,12 @@ hostname_format(Hostname) -> "localhost" end. -no_low_flag("-no_ssl2" = Flag) -> - case ssl_test_lib:supports_ssl_tls_version(sslv2) of - true -> - Flag; - false -> - "" - end; -no_low_flag(Flag) -> - Flag. - openssl_has_common_ciphers(Ciphers) -> OCiphers = ssl_test_lib:common_ciphers(openssl), has_common_ciphers(Ciphers, OCiphers). -has_common_ciphers([], OCiphers) -> +has_common_ciphers([], _) -> false; has_common_ciphers([Cipher | Rest], OCiphers) -> case lists:member(Cipher, OCiphers) of diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl index 875399db76..ead18aeb73 100644 --- a/lib/ssl/test/ssl_upgrade_SUITE.erl +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -47,10 +47,7 @@ init_per_suite(Config0) -> {skip, Reason} -> {skip, Reason}; Config -> - Result = - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config), - proplists:get_value(priv_dir, Config)), - ssl_test_lib:cert_options(Config) + ssl_test_lib:make_rsa_cert(Config) end catch _:_ -> {skip, "Crypto did not start"} @@ -149,8 +146,8 @@ use_connection(Socket) -> end. soft_start_connection(Config, ResulProxy) -> - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = start_server([{node, ServerNode}, {port, 0}, {from, ResulProxy}, @@ -166,8 +163,8 @@ soft_start_connection(Config, ResulProxy) -> {Server, Client}. restart_start_connection(Config, ResulProxy) -> - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = start_server([{node, ServerNode}, {port, 0}, {from, ResulProxy}, 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..b5545b71f7 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2.1 +SSL_VSN = 9.2.3 diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index 518a085c89..6308420c52 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -513,7 +513,7 @@ <title>Date and Time Source</title> <p>Local time is obtained from the Erlang BIF <c>localtime/0</c>. Universal time is computed from the BIF <c>universaltime/0</c>.</p> - <p>The following fapply:</p> + <p>The following apply:</p> <list type="bulleted"> <item>There are 86400 seconds in a day.</item> <item>There are 365 days in an ordinary year.</item> diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index 8e4e002000..8b9502a3b1 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -1090,8 +1090,8 @@ ok </item> <item> <p><c>select</c> - The table is traversed by calling - <seealso marker="dets:select/3"><c>dets:select/3</c></seealso> and - <seealso marker="dets:select/1"><c>dets:select/1</c></seealso>. + <seealso marker="dets#select/3"><c>dets:select/3</c></seealso> and + <seealso marker="dets#select/1"><c>dets:select/1</c></seealso>. Option <c>n_objects</c> determines the number of objects returned (the third argument of <c>select/3</c>). The match specification (the second argument of diff --git a/lib/stdlib/doc/src/digraph_utils.xml b/lib/stdlib/doc/src/digraph_utils.xml index 13b0aaad9e..a23b02c6c1 100644 --- a/lib/stdlib/doc/src/digraph_utils.xml +++ b/lib/stdlib/doc/src/digraph_utils.xml @@ -371,7 +371,7 @@ the default, the type of <c><anno>Digraph</anno></c> is used for the subgraph as well. Otherwise the option value of <c>type</c> is used as argument to - <seealso marker="digraph:new/1"><c>digraph:new/1</c></seealso>.</p> + <seealso marker="digraph#new/1"><c>digraph:new/1</c></seealso>.</p> <p>If the value of option <c>keep_labels</c> is <c>true</c>, which is the default, the <seealso marker="#label">labels</seealso> of vertices and edges 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/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 570c9c7cb6..08aa1865e8 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -42,11 +42,8 @@ <section> <title>Data Structure</title> - <code type="none"> -{Size, Tree}</code> - - <p><c>Tree</c> is composed of nodes of the form <c>{Key, Value, Smaller, - Bigger}</c> and the "empty tree" node <c>nil</c>.</p> + <p>Trees and iterators are built using opaque data structures that should + not be pattern-matched from outside this module.</p> <p>There is no attempt to balance trees after deletions. As deletions do not increase the height of a tree, this should be OK.</p> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 23c3f6e981..ef12e525e3 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -31,6 +31,39 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 3.8.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug in gen_statem has been fixed where the internal + timeout message could arrive as an info to the callback + module during high load due to incorrect use of + asynchronous timer cancel.</p> + <p> + Own Id: OTP-15295</p> + </item> + </list> + </section> + +</section> + +<section><title>STDLIB 3.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a performance regression when reading files + opened with the <c>compressed</c> flag.</p> + <p> + Own Id: OTP-15706 Aux Id: ERIERL-336 </p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index aeb9f48735..bb983903a9 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -166,7 +166,7 @@ <fsummary>Hibernate a process until a message is sent to it.</fsummary> <desc> <p>This function does the same as (and does call) the - <seealso marker="erts:erlang#erlang:hibernate/3"> + <seealso marker="erts:erlang#hibernate/3"> <c>hibernate/3</c></seealso> BIF, but ensures that exception handling and logging continues to work as expected when the process wakes up.</p> 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/doc/src/queue.xml b/lib/stdlib/doc/src/queue.xml index 83a8afea81..89cce6d85b 100644 --- a/lib/stdlib/doc/src/queue.xml +++ b/lib/stdlib/doc/src/queue.xml @@ -168,7 +168,7 @@ <fsummary>Test if a queue is empty.</fsummary> <desc> <p>Tests if <c><anno>Q</anno></c> is empty and returns <c>true</c> if - so, otherwise otherwise.</p> + so, otherwise <c>false</c>.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/slave.xml b/lib/stdlib/doc/src/slave.xml index 778c5f66e5..f9e42ad47d 100644 --- a/lib/stdlib/doc/src/slave.xml +++ b/lib/stdlib/doc/src/slave.xml @@ -51,7 +51,7 @@ <p>An alternative to the <c>ssh</c> program can be specified on the command line to - <seealso marker="erts:erl#erl"><c>erl(1)</c></seealso> as follows:</p> + <seealso marker="erts:erl"><c>erl(1)</c></seealso> as follows:</p> <pre> -rsh Program</pre> @@ -140,7 +140,7 @@ rpc:call(N, slave, pseudo, [node(), [pxw_server]]).</code> <p>Argument <c><anno>Args</anno></c> is used to set <c>erl</c> command-line arguments. If provided, it is passed to the new node and can be used for a variety of purposes; see - <seealso marker="erts:erl#erl"><c>erl(1)</c></seealso>.</p> + <seealso marker="erts:erl"><c>erl(1)</c></seealso>.</p> <p>As an example, suppose that you want to start a slave node at host <c>H</c> with node name <c>Name@H</c> and want the slave node to have the following properties:</p> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 3ec78a2667..0cd0aef124 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. 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. @@ -79,6 +79,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity +-type module_or_mfa() :: module() | mfa(). + -record(typeinfo, {attr, line}). %% Usage of records, functions, and imports. The variable table, which @@ -115,6 +117,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: erl_anno:anno(), clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated + not_removed=gb_sets:empty() %Not considered removed + :: gb_sets:set(module_or_mfa()), func=[], %Current function warn_format=0, %Warn format calls enabled_warnings=[], %All enabled warnings (ordset). @@ -382,6 +386,8 @@ format_error({redefine_callback, {F, A}}) -> format_error({bad_callback, {M, F, A}}) -> io_lib:format("explicit module not allowed for callback ~tw:~tw/~w", [M, F, A]); +format_error({bad_module, {M, F, A}}) -> + io_lib:format("spec for function ~w:~tw/~w from other module", [M, F, A]); format_error({spec_fun_undefined, {F, A}}) -> io_lib:format("spec for undefined function ~tw/~w", [F, A]); format_error({missing_spec, {F,A}}) -> @@ -573,7 +579,10 @@ start(File, Opts) -> false, Opts)}, {missing_spec_all, bool_option(warn_missing_spec_all, nowarn_missing_spec_all, - false, Opts)} + false, Opts)}, + {removed, + bool_option(warn_removed, nowarn_removed, + true, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], Enabled = ordsets:from_list(Enabled1), @@ -670,8 +679,9 @@ forms(Forms0, St0) -> no_auto = AutoImportSuppressed}), St2 = bif_clashes(Forms, St1), St3 = not_deprecated(Forms, St2), - St4 = foldl(fun form/2, pre_scan(Forms, St3), Forms), - post_traversal_check(Forms, St4). + St4 = not_removed(Forms, St3), + St5 = foldl(fun form/2, pre_scan(Forms, St4), Forms), + post_traversal_check(Forms, St5). pre_scan([{attribute,L,compile,C} | Fs], St) -> case is_warn_enabled(export_all, St) andalso @@ -846,6 +856,24 @@ not_deprecated(Forms, #lint{compile=Opts}=St0) -> end, St0, ML), St1#lint{not_deprecated = ordsets:from_list(Nowarn)}. +%% not_removed(Forms, State0) -> State + +not_removed(Forms, #lint{compile=Opts}=St0) -> + %% There are no line numbers in St0#lint.compile. + MFAsL = [{MFA,L} || + {attribute, L, compile, Args} <- Forms, + {nowarn_removed, MFAs0} <- lists:flatten([Args]), + MFA <- lists:flatten([MFAs0])], + Nowarn = [MFA || + {nowarn_removed, MFAs0} <- Opts, + MFA <- lists:flatten([MFAs0])], + St1 = foldl(fun ({{M, _F, _A}, L}, St2) -> + check_module_name(M, L, St2); + ({M,L}, St2) -> + check_module_name(M, L, St2) + end, St0, MFAsL), + St1#lint{not_removed = gb_sets:from_list(Nowarn)}. + %% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A disallowed_compile_flags(Forms, St0) -> %% There are (still) no line numbers in St0#lint.compile. @@ -2250,6 +2278,9 @@ expr({'fun',Line,Body}, Vt, St) -> case Body of {clauses,Cs} -> fun_clauses(Cs, Vt, St); + {function,record_info,2} -> + %% It is illegal to call record_info/2 with unknown arguments. + {[],add_error(Line, illegal_record_info, St)}; {function,F,A} -> %% BifClash - Fun expression %% N.B. Only allows BIFs here as well, NO IMPORTS!! @@ -2981,7 +3012,13 @@ spec_decl(Line, MFA0, TypeSpecs, St00 = #lint{specs = Specs, module = Mod}) -> St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of true -> add_error(Line, {redefine_spec, MFA0}, St1); - false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1) + false -> + case MFA of + {Mod, _, _} -> + check_specs(TypeSpecs, spec_wrong_arity, Arity, St1); + _ -> + add_error(Line, {bad_module, MFA}, St1) + end end. %% callback_decl(Line, Fun, Types, State) -> State. @@ -3769,13 +3806,23 @@ deprecated_function(Line, M, F, As, St) -> add_warning(Line, {deprecated, MFA, Replacement, Rel}, St) end; {removed, String} when is_list(String) -> - add_warning(Line, {removed, MFA, String}, St); + add_removed_warning(Line, MFA, {removed, MFA, String}, St); {removed, Replacement, Rel} -> - add_warning(Line, {removed, MFA, Replacement, Rel}, St); + add_removed_warning(Line, MFA, {removed, MFA, Replacement, Rel}, St); no -> St end. +add_removed_warning(Line, {M, _, _}=MFA, Warning, #lint{not_removed=NotRemoved}=St) -> + case is_warn_enabled(removed, St) andalso + not gb_sets:is_element(M, NotRemoved) andalso + not gb_sets:is_element(MFA, NotRemoved) of + true -> + add_warning(Line, Warning, St); + false -> + St + end. + -dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index ada3ff5de3..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); @@ -882,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)}. @@ -939,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. @@ -983,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 @@ -1000,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). @@ -1038,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) -> @@ -1069,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) -> @@ -1090,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, @@ -1150,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)). @@ -1184,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/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 2b5a374cf2..21d66c5529 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -412,14 +412,25 @@ write_port(Port) -> write_ref(Ref) -> erlang:ref_to_list(Ref). +write_map(_, 1, _E) -> "#{}"; write_map(Map, D, E) when is_integer(D) -> - [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}]. + I = maps:iterator(Map), + case maps:next(I) of + {K, V, NextI} -> + D0 = D - 1, + W = write_map_assoc(K, V, D0, E), + [$#,${,[W | write_map_body(NextI, D0, D0, E)],$}]; + none -> "#{}" + end. -write_map_body(_, 1, _D0, _E) -> "..."; -write_map_body([], _, _D0, _E) -> []; -write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E); -write_map_body([{K,V}|KVs], D, D0, E) -> - [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)]. +write_map_body(_, 1, _D0, _E) -> ",..."; +write_map_body(I, D, D0, E) -> + case maps:next(I) of + {K, V, NextI} -> + W = write_map_assoc(K, V, D0, E), + [$,,W|write_map_body(NextI, D - 1, D0, E)]; + none -> "" + end. write_map_assoc(K, V, D, E) -> [write1(K, D, E)," => ",write1(V, D, E)]. diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index d1aa4cd157..157cc07e19 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -327,11 +327,11 @@ indentation([], I) -> I. %% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String %% These are the dispatch functions for the various formatting controls. -control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) -> +control_small($s, [A], F, Adj, P, Pad, latin1=Enc) when is_atom(A) -> L = iolist_to_chars(atom_to_list(A)), - string(L, F, Adj, P, Pad); -control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) -> - string(atom_to_list(A), F, Adj, P, Pad); + string(L, F, Adj, P, Pad, Enc); +control_small($s, [A], F, Adj, P, Pad, unicode=Enc) when is_atom(A) -> + string(atom_to_list(A), F, Adj, P, Pad, Enc); control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> @@ -371,12 +371,12 @@ control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad); control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> []; control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small. -control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) -> - L = iolist_to_chars(L0), - string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad); -control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) -> - L = cdata_to_chars(L0), - uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad)); +control_limited($s, [L0], F, Adj, P, Pad, latin1=Enc, _Str, CL, _I) -> + L = iolist_to_chars(L0, F, CL), + string(L, limit_field(F, CL), Adj, P, Pad, Enc); +control_limited($s, [L0], F, Adj, P, Pad, unicode=Enc, _Str, CL, _I) -> + L = cdata_to_chars(L0, F, CL), + uniconv(string(L, limit_field(F, CL), Adj, P, Pad, Enc)); control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) -> Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]), term(Chars, F, Adj, P, Pad); @@ -718,7 +718,10 @@ fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 -> end. -%% iolist_to_chars(iolist()) -> io_lib:chars() +iolist_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> + iolist_to_chars(Cs); +iolist_to_chars(Cs, _, CharsLimit) -> + limit_iolist_to_chars(Cs, sub(CharsLimit, 3), [], normal). % three dots iolist_to_chars([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 -> [C | iolist_to_chars(Cs)]; @@ -729,12 +732,34 @@ iolist_to_chars([]) -> iolist_to_chars(B) when is_binary(B) -> binary_to_list(B). -%% cdata() :: clist() | cbinary() -%% clist() :: maybe_improper_list(char() | cbinary() | clist(), -%% cbinary() | nil()) -%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary() +limit_iolist_to_chars(Cs, 0, S, normal) -> + L = limit_iolist_to_chars(Cs, 4, S, final), + case iolist_size(L) of + N when N < 4 -> L; + 4 -> "..." + end; +limit_iolist_to_chars(_Cs, 0, _S, final) -> []; +limit_iolist_to_chars([C|Cs], Limit, S, Mode) when C >= $\000, C =< $\377 -> + [C | limit_iolist_to_chars(Cs, Limit - 1, S, Mode)]; +limit_iolist_to_chars([I|Cs], Limit, S, Mode) -> + limit_iolist_to_chars(I, Limit, [Cs|S], Mode); +limit_iolist_to_chars([], _Limit, [], _Mode) -> + []; +limit_iolist_to_chars([], Limit, [Cs|S], Mode) -> + limit_iolist_to_chars(Cs, Limit, S, Mode); +limit_iolist_to_chars(B, Limit, S, Mode) when is_binary(B) -> + case byte_size(B) of + Sz when Sz > Limit -> + {B1, B2} = split_binary(B, Limit), + [binary_to_list(B1) | limit_iolist_to_chars(B2, 0, S, Mode)]; + Sz -> + [binary_to_list(B) | limit_iolist_to_chars([], Limit-Sz, S, Mode)] + end. -%% cdata_to_chars(cdata()) -> io_lib:chars() +cdata_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> + cdata_to_chars(Cs); +cdata_to_chars(Cs, _, CharsLimit) -> + limit_cdata_to_chars(Cs, sub(CharsLimit, 3), normal). % three dots cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 -> [C | cdata_to_chars(Cs)]; @@ -748,11 +773,25 @@ cdata_to_chars(B) when is_binary(B) -> _ -> binary_to_list(B) end. -limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S; -limit_string(S, _F, CharsLimit) -> - case io_lib:chars_length(S) =< CharsLimit of - true -> S; - false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."] +limit_cdata_to_chars(Cs, 0, normal) -> + L = limit_cdata_to_chars(Cs, 4, final), + case string:length(L) of + N when N < 4 -> L; + 4 -> "..." + end; +limit_cdata_to_chars(_Cs, 0, final) -> []; +limit_cdata_to_chars(Cs, Limit, Mode) -> + case string:next_grapheme(Cs) of + {error, <<C,Cs1/binary>>} -> + %% This is how ~ts handles Latin1 binaries with option + %% chars_limit. + [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]; + {error, [C|Cs1]} -> % not all versions of module string return this + [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]; + [] -> + []; + [GC|Cs1] -> + [GC | limit_cdata_to_chars(Cs1, Limit - 1, Mode)] end. limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none -> @@ -762,30 +801,30 @@ limit_field(F, CharsLimit) -> %% string(String, Field, Adjust, Precision, PadChar) -string(S, none, _Adj, none, _Pad) -> S; -string(S, F, Adj, none, Pad) -> - string_field(S, F, Adj, io_lib:chars_length(S), Pad); -string(S, none, _Adj, P, Pad) -> - string_field(S, P, left, io_lib:chars_length(S), Pad); -string(S, F, Adj, P, Pad) when F >= P -> +string(S, none, _Adj, none, _Pad, _Enc) -> S; +string(S, F, Adj, none, Pad, Enc) -> + string_field(S, F, Adj, io_lib:chars_length(S), Pad, Enc); +string(S, none, _Adj, P, Pad, Enc) -> + string_field(S, P, left, io_lib:chars_length(S), Pad, Enc); +string(S, F, Adj, P, Pad, Enc) when F >= P -> N = io_lib:chars_length(S), if F > P -> if N > P -> - adjust(flat_trunc(S, P), chars(Pad, F-P), Adj); + adjust(flat_trunc(S, P, Enc), chars(Pad, F-P), Adj); N < P -> adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj); true -> % N == P adjust(S, chars(Pad, F-P), Adj) end; true -> % F == P - string_field(S, F, Adj, N, Pad) + string_field(S, F, Adj, N, Pad, Enc) end. -string_field(S, F, _Adj, N, _Pad) when N > F -> - flat_trunc(S, F); -string_field(S, F, Adj, N, Pad) when N < F -> +string_field(S, F, _Adj, N, _Pad, Enc) when N > F -> + flat_trunc(S, F, Enc); +string_field(S, F, Adj, N, Pad, _Enc) when N < F -> adjust(S, chars(Pad, F-N), Adj); -string_field(S, _, _, _, _) -> % N == F +string_field(S, _, _, _, _, _) -> % N == F S. %% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase) @@ -837,7 +876,10 @@ adjust(Data, Pad, right) -> [Pad|Data]. %% Flatten and truncate a deep list to at most N elements. -flat_trunc(List, N) when is_integer(N), N >= 0 -> +flat_trunc(List, N, latin1) when is_integer(N), N >= 0 -> + {S, _} = lists:split(N, lists:flatten(List)), + S; +flat_trunc(List, N, unicode) when is_integer(N), N >= 0 -> string:slice(List, 0, N). %% A deep version of lists:duplicate/2 diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 8f2fd7ea8f..b1a5991bf0 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -720,55 +720,40 @@ printable_list(_L, 1, _T, _Enc) -> false; printable_list(L, _D, T, latin1) when T < 0 -> io_lib:printable_latin1_list(L); -printable_list(L, _D, T, Enc) when T >= 0 -> - case slice(L, tsub(T, 2), Enc) of - false -> - false; - {prefix, Prefix} when Enc =:= latin1 -> - io_lib:printable_latin1_list(Prefix) andalso {true, Prefix}; - {prefix, Prefix} -> - %% Probably an overestimation. - io_lib:printable_list(Prefix) andalso {true, Prefix}; - all when Enc =:= latin1 -> - io_lib:printable_latin1_list(L); +printable_list(L, _D, T, latin1) when T >= 0 -> + N = tsub(T, 2), + case printable_latin1_list(L, N) of all -> - io_lib:printable_list(L) - end; -printable_list(L, _D, T, _Uni) when T < 0-> - io_lib:printable_list(L). - -slice(L, N, latin1) -> - try lists:split(N, L) of - {_, []} -> - all; - {[], _} -> - false; - {L1, _} -> - {prefix, L1} - catch - _:_ -> - all + true; + 0 -> + {L1, _} = lists:split(N, L), + {true, L1}; + _NC -> + false end; -slice(L, N, _Uni) -> +printable_list(L, _D, T, _Unicode) when T >= 0 -> + N = tsub(T, 2), %% Be careful not to traverse more of L than necessary. try string:slice(L, 0, N) of "" -> false; Prefix -> - %% Assume no binaries are introduced by string:slice(). case is_flat(L, lists:flatlength(Prefix)) of true -> case string:equal(Prefix, L) of true -> - all; + io_lib:printable_list(L); false -> - {prefix, Prefix} + io_lib:printable_list(Prefix) + andalso {true, Prefix} end; false -> false end catch _:_ -> false - end. + end; +printable_list(L, _D, T, _Uni) when T < 0-> + io_lib:printable_list(L). is_flat(_L, 0) -> true; @@ -845,7 +830,7 @@ printable_bin1(Bin, Start, Len) -> end. %% -> all | integer() >=0. Adopted from io_lib.erl. -% printable_latin1_list([_ | _], 0) -> 0; +printable_latin1_list([_ | _], 0) -> 0; printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ -> printable_latin1_list(Cs, N - 1); printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index b95cb8f525..fa34f19637 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -323,90 +323,6 @@ obsolete_1(snmp, N, A) -> obsolete_1(snmpa, old_info_format, 1) -> {deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"}; -obsolete_1(snmpm, agent_info, 3) -> - {removed, {snmpm, agent_info, 2}, "R16B"}; -obsolete_1(snmpm, update_agent_info, 5) -> - {removed, {snmpm, update_agent_info, 4}, "R16B"}; -obsolete_1(snmpm, g, 3) -> - {removed, {snmpm, sync_get, 3}, "R16B"}; -obsolete_1(snmpm, g, 4) -> - {removed, {snmpm, sync_get, [3,4]}, "R16B"}; -obsolete_1(snmpm, g, 5) -> - {removed, {snmpm, sync_get, [4,5]}, "R16B"}; -obsolete_1(snmpm, g, 6) -> - {removed, {snmpm, sync_get, [5,6]}, "R16B"}; -obsolete_1(snmpm, g, 7) -> - {removed, {snmpm, sync_get, 6}, "R16B"}; -obsolete_1(snmpm, ag, 3) -> - {removed, {snmpm, async_get, 3}, "R16B"}; -obsolete_1(snmpm, ag, 4) -> - {removed, {snmpm, async_get, [3,4]}, "R16B"}; -obsolete_1(snmpm, ag, 5) -> - {removed, {snmpm, async_get, [4,5]}, "R16B"}; -obsolete_1(snmpm, ag, 6) -> - {removed, {snmpm, async_get, [5,6]}, "R16B"}; -obsolete_1(snmpm, ag, 7) -> - {removed, {snmpm, async_get, 6}, "R16B"}; -obsolete_1(snmpm, gn, 3) -> - {removed, {snmpm, sync_get_next, 3}, "R16B"}; -obsolete_1(snmpm, gn, 4) -> - {removed, {snmpm, sync_get_next, [3,4]}, "R16B"}; -obsolete_1(snmpm, gn, 5) -> - {removed, {snmpm, sync_get_next, [4,5]}, "R16B"}; -obsolete_1(snmpm, gn, 6) -> - {removed, {snmpm, sync_get_next, [5,6]}, "R16B"}; -obsolete_1(snmpm, gn, 7) -> - {removed, {snmpm, sync_get_next, 6}, "R16B"}; -obsolete_1(snmpm, agn, 3) -> - {removed, {snmpm, async_get_next, 3}, "R16B"}; -obsolete_1(snmpm, agn, 4) -> - {removed, {snmpm, async_get_next, [3,4]}, "R16B"}; -obsolete_1(snmpm, agn, 5) -> - {removed, {snmpm, async_get_next, [4,5]}, "R16B"}; -obsolete_1(snmpm, agn, 6) -> - {removed, {snmpm, async_get_next, [5,6]}, "R16B"}; -obsolete_1(snmpm, agn, 7) -> - {removed, {snmpm, async_get_next, 6}, "R16B"}; -obsolete_1(snmpm, s, 3) -> - {removed, {snmpm, sync_set, 3}, "R16B"}; -obsolete_1(snmpm, s, 4) -> - {removed, {snmpm, sync_set, [3,4]}, "R16B"}; -obsolete_1(snmpm, s, 5) -> - {removed, {snmpm, sync_set, [4,5]}, "R16B"}; -obsolete_1(snmpm, s, 6) -> - {removed, {snmpm, sync_set, [5,6]}, "R16B"}; -obsolete_1(snmpm, s, 7) -> - {removed, {snmpm, sync_set, 6}, "R16B"}; -obsolete_1(snmpm, as, 3) -> - {removed, {snmpm, async_set, 3}, "R16B"}; -obsolete_1(snmpm, as, 4) -> - {removed, {snmpm, async_set, [3,4]}, "R16B"}; -obsolete_1(snmpm, as, 5) -> - {removed, {snmpm, async_set, [4,5]}, "R16B"}; -obsolete_1(snmpm, as, 6) -> - {removed, {snmpm, async_set, [5,6]}, "R16B"}; -obsolete_1(snmpm, as, 7) -> - {removed, {snmpm, async_set, 6}, "R16B"}; -obsolete_1(snmpm, gb, 5) -> - {removed, {snmpm, sync_get_bulk, 5}, "R16B"}; -obsolete_1(snmpm, gb, 6) -> - {removed, {snmpm, sync_get_bulk, [5,6]}, "R16B"}; -obsolete_1(snmpm, gb, 7) -> - {removed, {snmpm, sync_get_bulk, [6,7]}, "R16B"}; -obsolete_1(snmpm, gb, 8) -> - {removed, {snmpm, sync_get_bulk, [7,8]}, "R16B"}; -obsolete_1(snmpm, gb, 9) -> - {removed, {snmpm, sync_get_bulk, 8}, "R16B"}; -obsolete_1(snmpm, agb, 5) -> - {removed, {snmpm, async_get_bulk, 5}, "R16B"}; -obsolete_1(snmpm, agb, 6) -> - {removed, {snmpm, async_get_bulk, [5,6]}, "R16B"}; -obsolete_1(snmpm, agb, 7) -> - {removed, {snmpm, async_get_bulk, [6,7]}, "R16B"}; -obsolete_1(snmpm, agb, 8) -> - {removed, {snmpm, async_get_bulk, [7,8]}, "R16B"}; -obsolete_1(snmpm, agb, 9) -> - {removed, {snmpm, async_get_bulk, 8}, "R16B"}; %% *** MEGACO *** @@ -417,6 +333,7 @@ obsolete_1(megaco, format_versions, 1) -> %% *** OS-MON-MIB *** +%% FIXME: Remove this warning in OTP 24. obsolete_1(os_mon_mib, _, _) -> {removed, "was removed in 22.0"}; @@ -431,64 +348,6 @@ obsolete_1(auth, node_cookie, 1) -> obsolete_1(auth, node_cookie, 2) -> {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; - -%% Added in R13A. -obsolete_1(regexp, _, _) -> - {removed, "removed in R15; use the re module instead"}; - -%% Added in R13B04. -obsolete_1(erlang, concat_binary, 1) -> - {removed,{erlang,list_to_binary,1},"R15B"}; - -%% Added in R14A. -obsolete_1(ssl, peercert, 2) -> - {removed ,"removed in R15A; use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"}; - -%% Added in R14B. -obsolete_1(public_key, pem_to_der, 1) -> - {removed,"removed in R15A; use file:read_file/1 and public_key:pem_decode/1"}; -obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 -> - {removed, "removed in R15A; use public_key:pem_entry_decode/1"}; - -%% Added in R14B03. -obsolete_1(docb_gen, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; -obsolete_1(docb_transform, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; -obsolete_1(docb_xml_check, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; - -%% Added in R15B -obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"}; -obsolete_1(ssl, pid, 1) -> - {removed,"was removed in R16; is no longer needed"}; -obsolete_1(inviso, _, _) -> - {removed,"the inviso application was removed in R16"}; - -%% Added in R15B01. -obsolete_1(ssh, sign_data, 2) -> - {removed,"removed in R16A; use public_key:pem_decode/1, public_key:pem_entry_decode/1 " - "and public_key:sign/3 instead"}; -obsolete_1(ssh, verify_data, 3) -> - {removed,"removed in R16A; use public_key:ssh_decode/1, and public_key:verify/4 instead"}; - %% Added in R16 obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented? {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; @@ -609,10 +468,8 @@ obsolete_1(queue, lait, 1) -> %% Removed in OTP 19. -obsolete_1(overload, _, _) -> - {removed, "removed in OTP 19"}; obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> - {removed, {rpc, multi_server_call, A}, "removed in OTP 19"}; + {removed, {rpc, multi_server_call, A}, "19.0"}; %% Added in OTP 20. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 37ea97c353..9a1b92a87c 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -41,7 +41,10 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -56,4 +59,7 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 1f8bdc5432..a418754caf 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -128,7 +128,8 @@ length(CD) -> to_graphemes(CD0) -> case unicode_util:gc(CD0) of [GC|CD] -> [GC|to_graphemes(CD)]; - [] -> [] + [] -> []; + {error, Err} -> error({badarg, Err}) end. %% Compare two strings return boolean, assumes that the input are @@ -332,7 +333,10 @@ uppercase(<<CP1/utf8, Rest/binary>>=Orig) -> catch unchanged -> Orig end; uppercase(<<>>) -> - <<>>. + <<>>; +uppercase(Bin) -> + error({badarg, Bin}). + %% Lowercase all chars in Str -spec lowercase(String::unicode:chardata()) -> unicode:chardata(). @@ -346,7 +350,10 @@ lowercase(<<CP1/utf8, Rest/binary>>=Orig) -> catch unchanged -> Orig end; lowercase(<<>>) -> - <<>>. + <<>>; +lowercase(Bin) -> + error({badarg, Bin}). + %% Make a titlecase of the first char in Str -spec titlecase(String::unicode:chardata()) -> unicode:chardata(). @@ -375,7 +382,9 @@ casefold(<<CP1/utf8, Rest/binary>>=Orig) -> catch unchanged -> Orig end; casefold(<<>>) -> - <<>>. + <<>>; +casefold(Bin) -> + error({badarg, Bin}). -spec to_integer(String) -> {Int, Rest} | {'error', Reason} when String :: unicode:chardata(), @@ -544,7 +553,8 @@ length_1([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2) -> length_1(Str, N) -> case unicode_util:gc(Str) of [] -> N; - [_|Rest] -> length_1(Rest, N+1) + [_|Rest] -> length_1(Rest, N+1); + {error, Err} -> error({badarg, Err}) end. length_b(<<CP2/utf8, Rest/binary>>, CP1, N) @@ -554,7 +564,8 @@ length_b(Bin0, CP1, N) -> [_|Bin1] = unicode_util:gc([CP1|Bin0]), case unicode_util:cp(Bin1) of [] -> N+1; - [CP3|Bin] -> length_b(Bin, CP3, N+1) + [CP3|Bin] -> length_b(Bin, CP3, N+1); + {error, Err} -> error({badarg, Err}) end. equal_1([A|AR], [B|BR]) when is_integer(A), is_integer(B) -> @@ -599,7 +610,8 @@ reverse_1([CP1|[CP2|_]=Cont], Acc) when ?ASCII_LIST(CP1,CP2) -> reverse_1(CD, Acc) -> case unicode_util:gc(CD) of [GC|Rest] -> reverse_1(Rest, [GC|Acc]); - [] -> Acc + [] -> Acc; + {error, Err} -> error({badarg, Err}) end. reverse_b(<<CP2/utf8, Rest/binary>>, CP1, Acc) @@ -609,7 +621,8 @@ reverse_b(Bin0, CP1, Acc) -> [GC|Bin1] = unicode_util:gc([CP1|Bin0]), case unicode_util:cp(Bin1) of [] -> [GC|Acc]; - [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc]) + [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc]); + {error, Err} -> error({badarg, Err}) end. slice_l0(<<CP1/utf8, Bin/binary>>, N) when N > 0 -> @@ -622,7 +635,8 @@ slice_l([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 -> slice_l(CD, N) when N > 0 -> case unicode_util:gc(CD) of [_|Cont] -> slice_l(Cont, N-1); - [] -> [] + [] -> []; + {error, Err} -> error({badarg, Err}) end; slice_l(Cont, 0) -> Cont. @@ -634,7 +648,8 @@ slice_lb(Bin, CP1, N) -> if N > 1 -> case unicode_util:cp(Rest) of [CP2|Cont] -> slice_lb(Cont, CP2, N-1); - [] -> <<>> + [] -> <<>>; + {error, Err} -> error({badarg, Err}) end; N =:= 1 -> Rest @@ -647,7 +662,10 @@ slice_trail(Orig, N) when is_binary(Orig) -> Sz = byte_size(Orig) - Length, <<Keep:Sz/binary, _/binary>> = Orig, Keep; - _ -> <<>> + <<_, _/binary>> when N > 0 -> + error({badarg, Orig}); + _ -> + <<>> end; slice_trail(CD, N) when is_list(CD) -> slice_list(CD, N). @@ -657,7 +675,8 @@ slice_list([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 -> slice_list(CD, N) when N > 0 -> case unicode_util:gc(CD) of [GC|Cont] -> append(GC, slice_list(Cont, N-1)); - [] -> [] + [] -> []; + {error, Err} -> error({badarg, Err}) end; slice_list(_, 0) -> []. @@ -668,7 +687,8 @@ slice_bin(CD, CP1, N) when N > 0 -> [_|Bin] = unicode_util:gc([CP1|CD]), case unicode_util:cp(Bin) of [CP2|Cont] -> slice_bin(Cont, CP2, N-1); - [] -> 0 + [] -> 0; + {error, Err} -> error({badarg, Err}) end; slice_bin(CD, CP1, 0) -> byte_size(CD)+byte_size(<<CP1/utf8>>). @@ -703,14 +723,18 @@ uppercase_bin(CP1, Bin, Changed) -> [] when Changed -> [CP1]; [] -> - throw(unchanged) + throw(unchanged); + {error, Err} -> + error({badarg, Err}) end; [Char|CPs] -> case unicode_util:cp(CPs) of [Next|Rest] -> [Char|uppercase_bin(Next, Rest, true)]; [] -> - [Char] + [Char]; + {error, Err} -> + error({badarg, Err}) end end. @@ -744,14 +768,18 @@ lowercase_bin(CP1, Bin, Changed) -> [] when Changed -> [CP1]; [] -> - throw(unchanged) + throw(unchanged); + {error, Err} -> + error({badarg, Err}) end; [Char|CPs] -> case unicode_util:cp(CPs) of [Next|Rest] -> [Char|lowercase_bin(Next, Rest, true)]; [] -> - [Char] + [Char]; + {error, Err} -> + error({badarg, Err}) end end. @@ -785,14 +813,18 @@ casefold_bin(CP1, Bin, Changed) -> [] when Changed -> [CP1]; [] -> - throw(unchanged) + throw(unchanged); + {error, Err} -> + error({badarg, Err}) end; [Char|CPs] -> case unicode_util:cp(CPs) of [Next|Rest] -> [Char|casefold_bin(Next, Rest, true)]; [] -> - [Char] + [Char]; + {error, Err} -> + error({badarg, Err}) end end. @@ -1634,7 +1666,9 @@ bin_search_inv_1(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Sep) -> bin_search_inv_1(<<>>, Cont, _Sep) -> {nomatch, Cont}; bin_search_inv_1([], Cont, _Sep) -> - {nomatch, Cont}. + {nomatch, Cont}; +bin_search_inv_1(Bin, _, _) -> + error({badarg, Bin}). bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) -> @@ -1666,7 +1700,9 @@ bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) -> bin_search_inv_n(<<>>, Cont, _Sep) -> {nomatch, Cont}; bin_search_inv_n([], Cont, _Sep) -> - {nomatch, Cont}. + {nomatch, Cont}; +bin_search_inv_n(Bin, _, _) -> + error({badarg, Bin}). bin_search_str(Bin0, Start, [], SearchCPs) -> Compiled = binary:compile_pattern(unicode:characters_to_binary(SearchCPs)), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index e791da48cf..e7882e0daf 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. +%% Copyright Ericsson AB 1999-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. @@ -68,7 +68,7 @@ non_latin1_module/1, otp_14323/1, stacktrace_syntax/1, otp_14285/1, otp_14378/1, - external_funs/1,otp_15456/1]). + external_funs/1,otp_15456/1,otp_15563/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -90,7 +90,7 @@ all() -> otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, stacktrace_syntax, otp_14285, otp_14378, external_funs, - otp_15456]. + otp_15456, otp_15563]. groups() -> [{unused_vars_warn, [], @@ -2109,11 +2109,32 @@ otp_5362(Config) when is_list(Config) -> {calendar,local_time_to_universal_time_dst,1}, "a future release"}}]}}, {call_removed_function, - <<"t(X) -> regexp:match(X).">>, + <<"t(X) -> erlang:hash(X, 10000).">>, [], {warnings, - [{1,erl_lint,{removed,{regexp,match,1}, - "removed in R15; use the re module instead"}}]}} + [{1,erl_lint,{removed,{erlang,hash,2},{erlang,phash2,2},"20.0"}}]}}, + + {nowarn_call_removed_function_1, + <<"t(X) -> erlang:hash(X, 10000).">>, + [{nowarn_removed,{erlang,hash,2}}], + []}, + + {nowarn_call_removed_function_2, + <<"t(X) -> os_mon_mib:any_function_really(erlang:hash(X, 10000)).">>, + [nowarn_removed], + []}, + + {call_removed_module, + <<"t(X) -> os_mon_mib:any_function_really(X).">>, + [], + {warnings,[{1,erl_lint, + {removed,{os_mon_mib,any_function_really,1}, + "was removed in 22.0"}}]}}, + + {nowarn_call_removed_module, + <<"t(X) -> os_mon_mib:any_function_really(X).">>, + [{nowarn_removed,os_mon_mib}], + []} ], @@ -3555,10 +3576,12 @@ basic_errors(Config) -> {illegal_record_info, <<"f1() -> record_info(42, record). - f2() -> record_info(shoe_size, record).">>, + f2() -> record_info(shoe_size, record). + f3() -> fun record_info/2.">>, [], {errors,[{1,erl_lint,illegal_record_info}, - {2,erl_lint,illegal_record_info}],[]}}, + {2,erl_lint,illegal_record_info}, + {3,erl_lint,illegal_record_info}],[]}}, {illegal_expr, <<"f() -> a:b.">>, @@ -3987,6 +4010,8 @@ non_latin1_module(Config) -> format_error(non_latin1_module_unsupported), BadCallback = {bad_callback,{'кирилли́ческий атом','кирилли́ческий атом',0}}, + BadModule = + {bad_module,{'кирилли́ческий атом','кирилли́ческий атом',0}}, "explicit module not allowed for callback " "'кирилли́ческий атом':'кирилли́ческий атом'/0" = format_error(BadCallback), @@ -4029,6 +4054,7 @@ non_latin1_module(Config) -> {11,erl_lint,illegal_guard_expr}, {15,erl_lint,non_latin1_module_unsupported}, {17,erl_lint,non_latin1_module_unsupported}, + {17,erl_lint,BadModule}, {20,erl_lint,non_latin1_module_unsupported}, {23,erl_lint,non_latin1_module_unsupported}, {25,erl_lint,non_latin1_module_unsupported}], @@ -4206,6 +4232,21 @@ external_funs(Config) when is_list(Config) -> run(Config, Ts), ok. +otp_15563(Config) when is_list(Config) -> + Ts = [{otp_15563, + <<"-type deep_list(A) :: [A | deep_list(A)]. + -spec lists:flatten(deep_list(A)) -> [A]. + -callback lists:concat([_]) -> string(). + -spec ?MODULE:foo() -> any(). + foo() -> a. + ">>, + [warn_unused_vars], + {errors,[{2,erl_lint,{bad_module,{lists,flatten,1}}}, + {3,erl_lint,{bad_callback,{lists,concat,1}}}], + []}}], + [] = run(Config, Ts), + ok. + format_error(E) -> lists:flatten(erl_lint:format_error(E)). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index f5d80e7e68..c0cfd26925 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_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_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. @@ -828,7 +829,7 @@ type_examples() -> "(t24()) -> D when is_subtype(D, atom())," " is_subtype(D, t14())," " is_subtype(D, '\\'t::4'()).">>}, - {ex32,<<"-spec mod:t2() -> any(). ">>}, + {ex32,<<"-spec erl_pp_test:t2() -> any(). ">>}, {ex33,<<"-opaque attributes_data() :: " "[{'column', column()} | {'line', info_line()} |" " {'text', string()}] | {line(),column()}. ">>}, @@ -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. @@ -1172,6 +1188,79 @@ otp_15592(_Config) -> "56789012345678901234:f(<<>>)">>), ok. +otp_15751(_Config) -> + ok = pp_expr(<<"try foo:bar() + catch + Reason : Stacktrace -> + {Reason, Stacktrace} + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason : Stacktrace -> + {Reason, Stacktrace} + end">>), + ok = pp_expr(<<"try foo:bar() + catch + Reason : _ -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason : _ -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + Reason -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason -> + Reason + 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) -> @@ -1303,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 87ca9bd32c..dd49288417 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -24,7 +24,7 @@ -export([default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1, privacy/1]). -export([empty/1,badinsert/1]). --export([time_lookup/1,badlookup/1,lookup_order/1]). +-export([badlookup/1,lookup_order/1]). -export([delete_elem/1,delete_tab/1,delete_large_tab/1, delete_large_named_table/1, evil_delete/1,baddelete/1,match_delete/1,table_leak/1]). @@ -42,6 +42,8 @@ select_bound_chunk/1, t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, t_select_delete/1,t_select_replace/1,t_select_replace_next_bug/1,t_ets_dets/1]). +-export([test_table_size_concurrency/1,test_table_memory_concurrency/1, + test_delete_table_while_size_snapshot/1, test_delete_table_while_size_snapshot_helper/0]). -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, @@ -156,14 +158,18 @@ all() -> whereis_table, delete_unfix_race, test_throughput_benchmark, - {group, benchmark}]. + {group, benchmark}, + test_table_size_concurrency, + test_table_memory_concurrency, + test_delete_table_while_size_snapshot]. + groups() -> [{new, [], [default, setbag, badnew, verybadnew, named, keypos2, privacy]}, {insert, [], [empty, badinsert]}, - {lookup, [], [time_lookup, badlookup, lookup_order]}, + {lookup, [], [badlookup, lookup_order]}, {lookup_element, [], [lookup_element_mult]}, {delete, [], [delete_elem, delete_tab, delete_large_tab, @@ -828,7 +834,11 @@ adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) -> {TabSz, EstSz} = erts_debug:get_internal_state('DbTable_words'), HTabSz = TabSz + EstCnt*EstSz, - {A0+TabSz, B0+HTabSz, C0+HTabSz, D0+HTabSz}. + OrdSetExtra = case erlang:system_info(wordsize) of + 8 -> 40; % larger stack on 64 bit architectures + _ -> 0 + end, + {A0+TabSz+OrdSetExtra, B0+HTabSz, C0+HTabSz, D0+HTabSz}. %% Misc. whitebox tests t_whitebox(Config) when is_list(Config) -> @@ -3384,31 +3394,6 @@ badinsert_do(Opts) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Test lookup timing. -time_lookup(Config) when is_list(Config) -> - %% just for timing, really - EtsMem = etsmem(), - Values = repeat_for_opts_all_table_types(fun time_lookup_do/1), - verify_etsmem(EtsMem), - {comment,lists:flatten(io_lib:format( - "~p ets lookups/s",[Values]))}. - -time_lookup_do(Opts) -> - Tab = ets_new(foo,Opts), - fill_tab(Tab,foo), - ets:insert(Tab,{{a,key},foo}), - N = 100000, - {Time,_} = timer:tc(fun() -> time_lookup_many(N, Tab) end), - Seconds = Time / 1000000, - true = ets:delete(Tab), - round(N / Seconds). % lookups/s - -time_lookup_many(0, _Tab) -> - ok; -time_lookup_many(N, Tab) -> - ets:lookup(Tab, {a,key}), - time_lookup_many(N-1, Tab). - %% Check proper return values from bad lookups in existing/non existing %% ets tables. badlookup(Config) when is_list(Config) -> @@ -4102,6 +4087,11 @@ slot_do(Opts) -> fill_tab(Tab,foo), Elts = ets:info(Tab,size), Elts = slot_loop(Tab,0,0), + case ets:info(Tab, type) of + ordered_set -> + '$end_of_table' = ets:slot(Tab,Elts); + _ -> ok + end, true = ets:delete(Tab), verify_etsmem(EtsMem). @@ -4453,6 +4443,131 @@ info_do(Opts) -> undefined = ets:info(non_existing_table_xxyy,safe_fixed), verify_etsmem(EtsMem). +size_loop(_T, 0, _, _) -> + ok; +size_loop(T, I, PrevSize, WhatToTest) -> + Size = ets:info(T, WhatToTest), + case Size < PrevSize of + true -> ct:fail("Bad ets:info/2"); + _ -> ok + end, + size_loop(T, I -1, Size, WhatToTest). + +add_loop(_T, 0) -> + ok; +add_loop(T, I) -> + ets:insert(T, {I}), + add_loop(T, I -1). + + +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_link(fun() -> + size_loop(T, SizeLoopSize, 0, WhatToTest), + P ! done + end) + || _ <- lists:seq(1, 6)], + spawn_link(fun() -> + add_loop(T, ItemsToAdd), + P ! done_add + end), + [receive + done -> ok; + done_add -> ok + end + || _ <- [ok|SpawnedSizeProcs]], + case WhatToTest =:= size of + true -> + ItemsToAdd = ets:info(T, size); + _ -> + ok + end, + erts_debug:set_internal_state(available_internal_state, IntStatePrevOn), + ok. + +test_table_size_concurrency(Config) when is_list(Config) -> + test_table_counter_concurrency(size). + +test_table_memory_concurrency(Config) when is_list(Config) -> + test_table_counter_concurrency(memory). + +%% Tests that calling the ets:delete operation on a table T with +%% decentralized counters works while ets:info(T, size) operations are +%% active +test_delete_table_while_size_snapshot(Config) when is_list(Config) -> + %% Run test case in a slave node as other test suites in stdlib + %% depend on that pids are ordered in creation order which is no + %% longer the case when many processes have been started before + Node = start_slave(), + ok = rpc:call(Node, ?MODULE, test_delete_table_while_size_snapshot_helper, []), + test_server:stop_node(Node), + ok. + +test_delete_table_while_size_snapshot_helper()-> + TopParent = self(), + repeat_par( + fun() -> + Table = ets:new(t, [public, ordered_set, + {write_concurrency, true}]), + Parent = self(), + NrOfSizeProcs = 100, + Pids = [ spawn(fun()-> size_process(Table, Parent) end) + || _ <- lists:seq(1, NrOfSizeProcs)], + timer:sleep(1), + ets:delete(Table), + [receive + table_gone -> ok; + Problem -> TopParent ! Problem + end || _ <- Pids] + end, + 15000), + receive + Problem -> throw(Problem) + after 0 -> ok + end. + +size_process(Table, Parent) -> + try ets:info(Table, size) of + N when is_integer(N) -> + size_process(Table, Parent); + undefined -> Parent ! table_gone; + E -> Parent ! {got_unexpected, E} + catch + E -> Parent ! {got_unexpected_exception, E} + end. + +start_slave() -> + MicroSecs = erlang:monotonic_time(), + Name = "ets_" ++ integer_to_list(MicroSecs), + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(list_to_atom(Name), slave, [{args, "-pa " ++ Pa}]), + Node. + +repeat_par(FunToRepeat, NrOfTimes) -> + repeat_par_help(FunToRepeat, NrOfTimes, NrOfTimes). + +repeat_par_help(_FunToRepeat, 0, OrgNrOfTimes) -> + repeat(fun()-> receive done -> ok end end, OrgNrOfTimes); +repeat_par_help(FunToRepeat, NrOfTimes, OrgNrOfTimes) -> + Parent = self(), + case NrOfTimes rem 5 of + 0 -> timer:sleep(1); + _ -> ok + end, + spawn(fun()-> + FunToRepeat(), + Parent ! done + end), + repeat_par_help(FunToRepeat, NrOfTimes-1, OrgNrOfTimes). + %% Test various duplicate_bags stuff. dups(Config) when is_list(Config) -> repeat_for_opts(fun dups_do/1). diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 824f5d19f2..9b6d8d7401 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -32,7 +32,7 @@ io_with_huge_message_queue/1, format_string/1, maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, otp_15076/1, - otp_15159/1, otp_15639/1]). + otp_15159/1, otp_15639/1, otp_15705/1]). -export([pretty/2, trf/3]). @@ -65,7 +65,7 @@ all() -> io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159, - otp_15639]. + otp_15639, otp_15705]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -2504,9 +2504,11 @@ otp_14983(_Config) -> trunc_string() -> "str " = trf("str ", [], 10), - "str ..." = trf("str ~s", ["str"], 6), + "str str" = trf("str ~s", ["str"], 6), + "str ..." = trf("str ~s", ["str1"], 6), "str str" = trf("str ~s", ["str"], 7), - "str ..." = trf("str ~8s", ["str"], 6), + "str str" = trf("str ~8s", ["str"], 6), + "str ..." = trf("str ~8s", ["str1"], 6), Pa = filename:dirname(code:which(?MODULE)), {ok, UNode} = test_server:start_node(printable_range_unicode, slave, [{args, " +pc unicode -pa " ++ Pa}]), @@ -2680,3 +2682,29 @@ otp_15639(_Config) -> "\"12345678\"..." = pretty("123456789"++[x], UOpts), "[[...]|...]" = pretty(["1","2","3","4","5","6","7","8"], UOpts), ok. + +otp_15705(_Config) -> + L = [<<"an">>,["at"],[["om"]]], + "..." = trf("~s", [L], 0), + "..." = trf("~s", [L], 1), + "..." = trf("~s", [L], 2), + "..." = trf("~s", [L], 3), + "a..." = trf("~s", [L], 4), + "an..." = trf("~s", [L], 5), + "anatom" = trf("~s", [L], 6), + L2 = ["a",[<<"na">>],[["tom"]]], + "..." = trf("~s", [L2], 3), + "a..." = trf("~s", [L2], 4), + "an..." = trf("~s", [L2], 5), + "anatom" = trf("~s", [L2], 6), + + A = [[<<"äpple"/utf8>>, "plus", <<"äpple">>]], + "äp..." = trf("~ts", [A], 5), + "äppleplusäpple" = trf("~ts", [A], 14), + U = [["ки"],"рилл","и́ческий атом"], + "ки..." = trf("~ts", [U], 5), + "кирилли́ческий..." = trf("~ts", [U], 16), + "кирилли́ческий атом" = trf("~ts", [U], 20), + + "|кирилли́чес|" = trf("|~10ts|", [U], -1), + ok. 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/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl index 50f7df7a2a..1abd9b1f2f 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl @@ -24,7 +24,7 @@ -export([init/1, terminate/3]). -export([state1/3, state2/3]). --behaivour(gen_fsm). +-behaviour(gen_fsm). %% API diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 248912c3f2..c9aadd7f10 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -103,6 +103,15 @@ debug() -> test(?LINE,?FUNCTION_NAME,B,C,D, false), test(?LINE,?FUNCTION_NAME,hd(C),[B|tl(C)],D, false)). +-define(TRY(Exp), + fun() -> + try Exp + catch _E:Reason:_ST -> + %% io:format("~p:~w: ~p: ~.0p ~p~n", + %% [?FUNCTION_NAME, ?LINE,_E,Reason, hd(_ST)]), + {'EXIT', Reason} + end + end()). is_empty(_) -> ?TEST("", [], true), @@ -126,6 +135,10 @@ length(_) -> ?TEST(["abc"|<<"abc">>], [], 6), ?TEST(["abc",["def"]], [], 6), ?TEST([<<97/utf8, 778/utf8, 98/utf8>>, [776,111,776]], [], 3), %% åäö in nfd + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:length(InvalidUTF8)), + {'EXIT', {badarg, _}} = ?TRY(string:length(<<$a, InvalidUTF8/binary, $z>>)), ok. equal(_) -> @@ -226,6 +239,8 @@ to_graphemes(_) -> true = erlang:length(GCs) =:= erlang:length(string:to_graphemes(NFD)), true = erlang:length(GCs) =:= erlang:length(string:to_graphemes(unicode:characters_to_nfc_list(String))), + + {'EXIT', {badarg, _}} = ?TRY(string:to_graphemes(<<$a,192,192,$z>>)), ok. reverse(_) -> @@ -238,6 +253,11 @@ reverse(_) -> ?TEST(Str2, [], lists:reverse(Str2)), ?TEST(Str3, [], lists:reverse(Str3)), true = string:reverse(Str3) =:= lists:reverse(string:to_graphemes(Str3)), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:reverse(InvalidUTF8)), + {'EXIT', {badarg, _}} = ?TRY(string:reverse(<<$a, InvalidUTF8/binary, $z>>)), + ok. slice(_) -> @@ -258,6 +278,14 @@ slice(_) -> ?TEST([<<"aå"/utf8>>,"äöbcd"], [3,3], "öbc"), ?TEST([<<"aåä"/utf8>>,"öbcd"], [3,10], "öbcd"), + InvalidUTF8 = <<192,192>>, + [$b, $c|InvalidUTF8] = string:slice(["abc", InvalidUTF8], 1), + InvalidUTF8 = string:slice(["abc", InvalidUTF8], 3), + {'EXIT', {badarg, _}} = ?TRY(string:slice(["abc", InvalidUTF8], 1, 5)), + BadUtf8 = <<$a, InvalidUTF8/binary, "teststring">>, + {'EXIT', {badarg, _}} = ?TRY(string:slice(BadUtf8, 2)), + {'EXIT', {badarg, _}} = ?TRY(string:slice(BadUtf8, 1, 5)), + {'EXIT', {badarg, _}} = ?TRY(string:slice(BadUtf8, 0, 5)), ok. pad(_) -> @@ -270,6 +298,10 @@ pad(_) -> ?TEST(Str, [10, trailing, $.], "Hallå....."), ?TEST(Str++["f"], [10, trailing, $.], "Hallåf...."), ?TEST(Str++[" flåwer"], [10, trailing, $.], "Hallå flåwer"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:pad(InvalidUTF8, 10, both, $.)), + {'EXIT', {badarg, _}} = ?TRY(string:pad(<<$a, InvalidUTF8/binary, $z>>, 10, both, $.)), ok. trim(_) -> @@ -300,6 +332,11 @@ trim(_) -> ?TEST([[<<"!v">>|<<204,128,$v,204,129>>]],[trailing, [[$v,769]]], [$!,$v,768]), ?TEST([[[<<"v">>|<<204,129,118,204,128,118>>],769,118,769]], [trailing, [[118,769]]], [$v,769,$v,768]), ?TEST([<<"vv">>|<<204,128,118,204,128>>], [trailing, [[118,768]]], "v"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:trim(InvalidUTF8, both, "az")), + %% Not checked (using binary search) + %% {'EXIT', {badarg, _}} = ?TRY(string:trim(<<$a, $b, InvalidUTF8/binary, $z>>, both, "az")), ok. chomp(_) -> @@ -400,6 +437,13 @@ take(_) -> ?TEST([<<"e">>,778,"åäöe", <<778/utf8>>, $e, 779], [[[$e,778]], true, trailing], {[$e,778]++"åäöe"++[778], [$e,779]}), + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:take(InvalidUTF8, [$.], false, leading)), + %% Not checked (using binary search) + %% {'EXIT', {badarg, _}} = ?TRY(string:take(InvalidUTF8, [$.], true, leading)), + %% {'EXIT', {badarg, _}} = ?TRY(string:take(InvalidUTF8, [$.], false, trailing)), + {'EXIT', {badarg, _}} = ?TRY(string:take(InvalidUTF8, [$.], true, trailing)), + ok. @@ -416,6 +460,11 @@ uppercase(_) -> ?TEST("ljLJ", [], "LJLJ"), ?TEST("LJlj", [], "LJLJ"), ?TEST("ß sharp s", [], "SS SHARP S"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:uppercase(InvalidUTF8)), + {'EXIT', {badarg, _}} = ?TRY(string:uppercase(<<$a, InvalidUTF8/binary, $z>>)), + ok. lowercase(_) -> @@ -429,6 +478,10 @@ lowercase(_) -> ?TEST(["Mic",<<"HAŁ"/utf8>>], [], "michał"), ?TEST("ß SHARP S", [], "ß sharp s"), ?TEST("İ I WITH DOT ABOVE", [], "i̇ i with dot above"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:lowercase(InvalidUTF8)), + {'EXIT', {badarg, _}} = ?TRY(string:lowercase(<<$a, InvalidUTF8/binary, $z>>)), ok. titlecase(_) -> @@ -442,6 +495,10 @@ titlecase(_) -> ?TEST("ljLJ", [], "LjLJ"), ?TEST("LJlj", [], "Ljlj"), ?TEST("ß sharp s", [], "Ss sharp s"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:titlecase(InvalidUTF8)), + <<$A, _/binary>> = ?TRY(string:titlecase(<<$a, InvalidUTF8/binary, $z>>)), ok. casefold(_) -> @@ -456,6 +513,10 @@ casefold(_) -> ?TEST("ß SHARP S", [], "ss sharp s"), ?TEST("ẞ SHARP S", [], "ss sharp s"), ?TEST("İ I WITH DOT ABOVE", [], "i̇ i with dot above"), + + InvalidUTF8 = <<192,192>>, + {'EXIT', {badarg, _}} = ?TRY(string:casefold(InvalidUTF8)), + {'EXIT', {badarg, _}} = ?TRY(string:casefold(<<$a, InvalidUTF8/binary, $z>>)), ok. @@ -740,7 +801,7 @@ meas(Config) -> _ -> % No scaling, run at most 1.5 min Tester = spawn(Exec), receive {test_done, Tester} -> ok - after 90000 -> + after 118000 -> io:format("Timelimit reached stopping~n",[]), exit(Tester, die) end, diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index 044b4e5834..6f55f204f4 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -428,7 +428,15 @@ mode(deep_l, Bin) -> [unicode:characters_to_list(Bin)]. fetch(Str, F) -> case F(Str) of [] -> []; - [CP|R] -> [CP|fetch(R,F)] + [CP|R] -> + %% If input is a binary R should be binary + if is_binary(Str) == false -> ok; + is_binary(R); R =:= [] -> ok; + true -> + io:format("Char: ~tc Tail:~tP~n", [CP,R,10]), + exit({bug, F}) + end, + [CP|fetch(R,F)] end. %% *Test.txt file helpers diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index 8636c69a0d..de67b18afc 100644 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -202,7 +202,8 @@ gen_static(Fd) -> io:put_chars(Fd, " {Upper,_} -> [Upper|Str];\n"), io:put_chars(Fd, " {Upper,_,_,_} -> [Upper|Str]\n"), io:put_chars(Fd, " end;\n"), - io:put_chars(Fd, " [] -> []\n"), + io:put_chars(Fd, " [] -> [];\n"), + io:put_chars(Fd, " {error,Err} -> error({badarg, Err})\n"), io:put_chars(Fd, " end.\n\n"), io:put_chars(Fd, "-spec lowercase(unicode:chardata()) -> " "maybe_improper_list(gc(),unicode:chardata()).\n"), @@ -213,7 +214,8 @@ gen_static(Fd) -> io:put_chars(Fd, " {_,Lower} -> [Lower|Str];\n"), io:put_chars(Fd, " {_,Lower,_,_} -> [Lower|Str]\n"), io:put_chars(Fd, " end;\n"), - io:put_chars(Fd, " [] -> []\n"), + io:put_chars(Fd, " [] -> [];\n"), + io:put_chars(Fd, " {error,Err} -> error({badarg, Err})\n"), io:put_chars(Fd, " end.\n\n"), io:put_chars(Fd, "-spec titlecase(unicode:chardata()) -> " "maybe_improper_list(gc(),unicode:chardata()).\n"), @@ -224,7 +226,8 @@ gen_static(Fd) -> io:put_chars(Fd, " {_,_,Title,_} -> [Title|Str];\n"), io:put_chars(Fd, " {Upper,_} -> [Upper|Str]\n"), io:put_chars(Fd, " end;\n"), - io:put_chars(Fd, " [] -> []\n"), + io:put_chars(Fd, " [] -> [];\n"), + io:put_chars(Fd, " {error,Err} -> error({badarg, Err})\n"), io:put_chars(Fd, " end.\n\n"), io:put_chars(Fd, "-spec casefold(unicode:chardata()) -> " "maybe_improper_list(gc(),unicode:chardata()).\n"), @@ -235,7 +238,8 @@ gen_static(Fd) -> io:put_chars(Fd, " {_,_,_,Fold} -> [Fold|Str];\n"), io:put_chars(Fd, " {_,Lower} -> [Lower|Str]\n"), io:put_chars(Fd, " end;\n"), - io:put_chars(Fd, " [] -> []\n"), + io:put_chars(Fd, " [] -> [];\n"), + io:put_chars(Fd, " {error,Err} -> error({badarg, Err})\n"), io:put_chars(Fd, " end.\n\n"), ok. @@ -619,7 +623,7 @@ gen_gc(Fd, GBP) -> GenHangulT = fun(Range) -> io:format(Fd, "gc_1~s gc_h_T(R1,[CP]);\n", [gen_clause(Range)]) end, [GenHangulT(CP) || CP <- merge_ranges(maps:get(t,GBP))], io:put_chars(Fd, "%% Handle Hangul LV and LVT special, since they are large\n"), - io:put_chars(Fd, "gc_1([CP|_]=R0) when 44000 < CP, CP < 56000 -> gc_h_lv_lvt(R0, []);\n"), + io:put_chars(Fd, "gc_1([CP|_]=R0) when 44000 < CP, CP < 56000 -> gc_h_lv_lvt(R0, R0, []);\n"), io:put_chars(Fd, "\n%% Handle Regional\n"), GenRegional = fun(Range) -> io:format(Fd, "gc_1~s gc_regional(R1,CP);\n", [gen_clause(Range)]) end, @@ -748,7 +752,7 @@ gen_gc(Fd, GBP) -> GenHangulL_2 = fun(Range) -> io:format(Fd, "~8c~s gc_h_V(R1,[CP|Acc]);\n", [$\s,gen_case_clause(Range)]) end, [GenHangulL_2(CP) || CP <- merge_ranges(maps:get(v,GBP))], - io:put_chars(Fd, " R1 -> gc_h_lv_lvt(R1, Acc)\n end.\n\n"), + io:put_chars(Fd, " R1 -> gc_h_lv_lvt(R1, R0, Acc)\n end.\n\n"), io:put_chars(Fd, "%% Handle Hangul V\n"), io:put_chars(Fd, "gc_h_V(R0, Acc) ->\n case cp(R0) of\n"), @@ -783,10 +787,10 @@ gen_gc(Fd, GBP) -> GenHangulLVT = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_T(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, [GenHangulLVT(CP) || CP <- merge_ranges(maps:get(lvt,GBP))], - io:put_chars(Fd, "gc_h_lv_lvt([CP|R], []) -> gc_extend(cp(R), R, CP);\n"), %% From gc_1/1 + io:put_chars(Fd, "gc_h_lv_lvt([CP|R1], _, []) -> gc_extend(cp(R1), R1, CP);\n"), %% From gc_1/1 io:put_chars(Fd, "%% Also handles error tuples\n"), - io:put_chars(Fd, "gc_h_lv_lvt(R, [CP]) -> gc_extend(R, R, CP);\n"), - io:put_chars(Fd, "gc_h_lv_lvt(R, Acc) -> gc_extend2(R, R, Acc).\n\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R1, R0, [CP]) -> gc_extend(R1, R0, CP);\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R1, R0, Acc) -> gc_extend2(R1, R0, Acc).\n\n"), ok. gen_compose_pairs(Fd, ExclData, Data) -> @@ -887,9 +891,9 @@ gen_clause({R0, R1}) -> io_lib:format("([CP|R1]=R0) when ~w =< CP, CP =< ~w ->", [R0,R1]). gen_clause2({R0, undefined}) -> - io_lib:format("([~w=CP|R1], Acc) ->", [R0]); + io_lib:format("([~w=CP|R1], R0, Acc) ->", [R0]); gen_clause2({R0, R1}) -> - io_lib:format("([CP|R1], Acc) when ~w =< CP, CP =< ~w ->", [R0,R1]). + io_lib:format("([CP|R1], R0, Acc) when ~w =< CP, CP =< ~w ->", [R0,R1]). gen_case_clause({R0, undefined}) -> io_lib:format("[~w=CP|R1] ->", [R0]); diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index cbefd6590a..80ec81b832 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 3.8 +STDLIB_VSN = 3.8.2 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/make.xml b/lib/tools/doc/src/make.xml index af2404707f..322d77323f 100644 --- a/lib/tools/doc/src/make.xml +++ b/lib/tools/doc/src/make.xml @@ -145,5 +145,10 @@ Modules. {'*',[debug_info]}. </code> <p></p> </section> + + <section> + <title>See Also</title> + <p><seealso marker="compiler:compile"><c>compile(3)</c></seealso></p> + </section> </erlref> 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/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index 2ee584d11a..fbdd298da3 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -50,8 +50,15 @@ ;; The -L option adds a directory to the load-path. It should be the ;; directory containing erlang.el and erlang-test.el. ;; -;; 3. Call the script test-erlang-mode in this directory. This script -;; use the second method. +;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and +;; tests_compiled/1 in this suite are using the second method. One +;; way to run this suite is with the ct_run tool, for example like the +;; following when standing at the OTP repo top directory: +;; +;; ct_run -suite lib/tools/test/emacs_SUITE +;; +;; Note that this creates a lot of html log files in the current +;; directory. ;;; Code: diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 38c0eba92b..0b3a2319e2 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,7 +4,7 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 -;; Version: 2.8.1 +;; Version: 2.8.2 ;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% @@ -87,7 +87,7 @@ "The Erlang programming language." :group 'languages) -(defconst erlang-version "2.8.1" +(defconst erlang-version "2.8.2" "The version number of Erlang mode.") (defcustom erlang-root-dir nil @@ -502,6 +502,13 @@ regardless of where in the line point is when the TAB command is used." :type 'boolean :safe 'booleanp) +(defcustom erlang-max-files-to-visit-for-refining-xrefs 32 + "Upper limit how many files to visit for checking arity. +When `nil' there is no limit." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -3689,10 +3696,13 @@ When an identifier is found return a list with 4 elements: module or nil. 2. Module - Module name string or nil. In case of a -qualified-function a search fails if no entries with correct -module are found. For other kinds the module is just a -preference. If no matching entries are found the search will be -retried without regard to module. +qualified-function the module is explicitly specified (like +module:fun()) and the search fails if no entries with correct +module are found. For other kinds the module is guessed: either +fetched from import statements or it is assumed to be the local +module. In these cases the module is just a preference. If no +matching entries are found the search will be retried without +regard to module. 3. Name - String name of function, module, record or macro. @@ -3704,18 +3714,22 @@ of arguments could be found, otherwise nil." (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) (skip-chars-backward "[:word:]_:'") - (cond ((looking-at erlang-module-function-regexp) + (cond ((and (eq (preceding-char) ??) + (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp))) + (erlang-get-qualified-function-id-at-point (erlang-get-module))) + ((looking-at erlang-module-function-regexp) (erlang-get-qualified-function-id-at-point)) ((looking-at (concat erlang-atom-regexp ":")) (erlang-get-module-id-at-point)) ((looking-at erlang-name-regexp) (erlang-get-some-other-id-at-point))))))) -(defun erlang-get-qualified-function-id-at-point () +(defun erlang-get-qualified-function-id-at-point (&optional module) (let ((kind 'qualified-function) - (module (erlang-remove-quotes - (buffer-substring-no-properties - (match-beginning 1) (match-end 1)))) + (module (or module + (erlang-remove-quotes + (buffer-substring-no-properties + (match-beginning 1) (match-end 1))))) (name (erlang-remove-quotes (buffer-substring-no-properties (match-beginning (1+ erlang-atom-regexp-matches)) @@ -3825,7 +3839,8 @@ of arguments could be found, otherwise nil." (let ((case-fold-search nil)) ; force string matching to be case sensitive (if (and (stringp str) (not (string-match (eval-when-compile - (concat "\\`" erlang-atom-regexp "\\'")) str))) + (concat "\\`" erlang-atom-regexp "\\'")) + str))) (progn (setq str (replace-regexp-in-string "'" "\\'" str t t )) (concat "'" str "'")) @@ -4879,15 +4894,36 @@ about Erlang modules." ;; The backend below is a wrapper around the built-in etags backend. ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +;; +;; In addition arity is also considered when jumping to definitions. +;; There is however currently no information about arity in the TAGS +;; file. Also two functions with the same name but different arity +;; _sometimes_ get one TAGS entry each and sometimes are joined in one +;; single entry. If they are directly consecutive they will be +;; joined. If there are other functions etc in between then they will +;; get one entry each. +;; +;; These limitations are present in both the etags program shipped +;; with GNU Emacs and the tags.erl program in this repository. +;; +;; Therefore erlang.el must complement the information in TAGS by +;; visiting files and checking arity. When searching for popular +;; function names (like init, handle_call etc) in a big TAGS file +;; (like one indexing this repository) this may be quite +;; time-consuming. There exists therefore an upper limit for the +;; number of files to visit (called +;; `erlang-max-files-to-visit-for-refining-xrefs'). +;; +;; As mentioned this xref implementation is based on the etags xref +;; implementation. But in the cases where arity is considered the +;; etags information structures (class xref-etags-location) will be +;; translated to our own structures which include arity (class +;; erlang-xref-location). This translation is started in the function +;; `erlang-refine-xrefs'. -(defvar erlang-current-arity nil - "The arity of the function currently being searched. - -There is no information about arity in the TAGS file. -Consecutive functions with same name but different arity will -only get one entry in the TAGS file. Matching TAGS entries are -therefore selected without regarding arity. The arity is -considered first when it is time to jump to the definition.") +;; I mention this as a head up that some of the functions below deal +;; with xref items with xref-etags-location and some deal with xref +;; items with erlang-xref-location. (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4895,127 +4931,80 @@ considered first when it is time to jump to the definition.") (when (locate-library (symbol-name feature)) (require feature))) -(and (erlang-soft-require 'xref) - (erlang-soft-require 'cl-generic) - (erlang-soft-require 'eieio) - (erlang-soft-require 'etags) - ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod etc. - (eval - '(progn - (cl-defmethod xref-backend-identifier-at-point - ((_backend (eql erlang-etags))) - (if (eq this-command 'xref-find-references) - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end)) - (thing-at-point 'symbol)) - (erlang-id-to-string (erlang-get-identifier-at-point)))) - - (cl-defmethod xref-backend-definitions - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier)) - - (cl-defmethod xref-backend-apropos - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier t)) - - (cl-defmethod xref-backend-identifier-completion-table - ((_backend (eql erlang-etags))) - (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table))) - - (defclass erlang-xref-location (xref-etags-location) ()) - - (defun erlang-convert-xrefs (xrefs) - (mapcar (lambda (xref) - (oset xref location (erlang-make-location - (oref xref location))) - xref) - xrefs)) - - (defun erlang-make-location (etags-location) - (with-slots (tag-info file) etags-location - (make-instance 'erlang-xref-location :tag-info tag-info - :file file))) - - (cl-defmethod xref-location-marker ((locus erlang-xref-location)) - (with-slots (tag-info file) locus - (with-current-buffer (find-file-noselect file) - (save-excursion - (or (erlang-goto-tag-location-by-arity tag-info) - (etags-goto-tag-location tag-info)) - ;; Reset erlang-current-arity. We want to jump to - ;; correct arity in the first attempt. That is now - ;; done. Possible remaining jumps will be from - ;; entries in the *xref* buffer and then we want to - ;; ignore the arity. (Alternatively we could remove - ;; all but one xref entry per file when we know the - ;; arity). - (setq erlang-current-arity nil) - (point-marker))))) - - (defun erlang-xref-context (xref) - (with-slots (tag-info) (xref-item-location xref) - (car tag-info)))))) - - -(defun erlang-goto-tag-location-by-arity (tag-info) - (when erlang-current-arity - (let* ((tag-text (car tag-info)) - (tag-pos (cdr (cdr tag-info))) - (tag-line (car (cdr tag-info))) - (regexp (erlang-tag-info-regexp tag-text)) - (startpos (or tag-pos - (when tag-line - (goto-char (point-min)) - (forward-line (1- tag-line)) - (point)) - (point-min)))) - (setq startpos (max (- startpos 2000) - (point-min))) - (goto-char startpos) - (let ((pos (or (erlang-search-by-arity regexp) - (unless (eq startpos (point-min)) - (goto-char (point-min)) - (erlang-search-by-arity regexp))))) - (when pos - (goto-char pos) - t))))) - -(defun erlang-tag-info-regexp (tag-text) - (concat "^" - (regexp-quote tag-text) - ;; Erlang function entries in TAGS includes the opening - ;; parenthesis for the argument list. Erlang macro entries - ;; do not. Add it here in order to end up in correct - ;; position for erlang-get-arity. - (if (string-prefix-p "-define" tag-text) - "\\s-*(" - ""))) - -(defun erlang-search-by-arity (regexp) - (let (pos) - (while (and (null pos) - (re-search-forward regexp nil t)) - (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) - (setq pos (point-at-bol)))) - pos)) - - +(when (and (erlang-soft-require 'xref) + (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) + (erlang-soft-require 'etags)) + ;; The purpose of using eval here is to avoid compilation + ;; warnings in emacsen without cl-defmethod etc. + (eval + '(progn + (cl-defmethod xref-backend-identifier-at-point ((_backend + (eql erlang-etags))) + (if (eq this-command 'xref-find-references) + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end)) + (thing-at-point 'symbol)) + (erlang-id-to-string (erlang-get-identifier-at-point)))) + + (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier)) + + (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier t)) + + (cl-defmethod xref-backend-identifier-completion-table + ((_backend (eql erlang-etags))) + (let ((erlang-replace-etags-tags-completion-table t)) + (tags-completion-table))) + + (defclass erlang-xref-location (xref-file-location) + ((arity :type fixnum :initarg :arity + :reader erlang-xref-location-arity)) + :documentation "An erlang location is a file location plus arity.") + + ;; This method definition only calls the superclass which is + ;; the default behaviour if it was not defined. It is only + ;; needed for "upgrade" purposes. In version 2.8.1 of + ;; erlang.el this method was defined differently and in case + ;; user switch to a new erlang.el without restarting Emacs + ;; this method needs to be redefined. + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (cl-call-next-method locus))))) + +;; If this function returns a single xref the user will jump to that +;; directly. If two or more xrefs are returned a *xref* window is +;; displayed and the user can choose where to jump. Hence we want to +;; return a single xref when we are pretty sure that is where the user +;; wants to go. Otherwise return all possible xrefs but sort them so +;; that xrefs in the local file is first and if arity is known sort +;; the xrefs with matching arity before others. + +;; Note that the arity sorting work may partly be undone later when +;; the hits are presented in the *xref* buffer since they then will be +;; grouped together by file. Ie when one file have one hit with +;; correct arity and others with wrong arity these hits will be +;; grouped together and may end up before hits with correct arity. (defun erlang-xref-find-definitions (identifier &optional is-regexp) (erlang-with-id (kind module name arity) identifier - (setq erlang-current-arity arity) (cond ((eq kind 'module) (erlang-xref-find-definitions-module name)) + ((eq kind 'qualified-function) + (erlang-xref-find-definitions-qualified-function module + name + arity + is-regexp)) (module - (erlang-xref-find-definitions-module-tag module + (erlang-xref-find-definitions-module-tag kind + module name - (eq kind - 'qualified-function) + arity is-regexp)) (t - (erlang-xref-find-definitions-tag kind name is-regexp))))) + (erlang-xref-find-definitions-tag kind name arity is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5040,65 +5029,252 @@ considered first when it is time to jump to the definition.") (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-visit-tags-table-buffer (cont cbuf) - (if (< emacs-major-version 26) - (visit-tags-table-buffer cont) - ;; Remove this with-no-warnings when Emacs 26 is the required - ;; version minimum. - (with-no-warnings - (visit-tags-table-buffer cont cbuf)))) - -(defun erlang-xref-find-definitions-module-tag (module +(defun erlang-xref-find-definitions-qualified-function (module + tag + arity + is-regexp) + "Find definitions of TAG in MODULE preferably with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If IS-REGEXP is non-nil then +TAG is a regexp." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + 'qualified-function + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-sort-by-arity module-xrefs arity)))) + + +;; We will end up here when erlang-get-some-other-id-at-point either +;; found module among the import statements or module is just the +;; current local file. +(defun erlang-xref-find-definitions-module-tag (kind + module tag - is-qualified + arity is-regexp) - "Find definitions of TAG and filter away definitions outside of -MODULE. If IS-QUALIFIED is nil and no definitions was found inside -the MODULE then return any definitions found outside. If -IS-REGEXP is non-nil then TAG is a regexp." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let ((xrefs (erlang-convert-xrefs - (etags--xref-find-definitions tag is-regexp))) - xrefs-in-module) - (dolist (xref xrefs) - (when (string-equal module (erlang-xref-module xref)) - (push xref xrefs-in-module))) - (cond (is-qualified xrefs-in-module) - (xrefs-in-module xrefs-in-module) - (t xrefs))))) - -(defun erlang-xref-find-definitions-tag (kind tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (regexp (erlang-etags-regexp kind tag is-regexp)) - (xrefs (erlang-convert-xrefs - (etags--xref-find-definitions regexp t))) - local-xrefs non-local-xrefs) - (while xrefs - (let ((xref (car xrefs))) - (if (string-equal (erlang-xref-truename-file xref) - current-file) - (push xref local-xrefs) - (push xref non-local-xrefs)) - (setq xrefs (cdr xrefs)))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + "Find definitions of TAG preferably in MODULE and with arity ARITY. +Return definitions outside MODULE if none are found inside. If +IS-REGEXP is non-nil then TAG is a regexp. + +If one single perfect match was found return only that (ignoring +other definitions matching TAG)." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + kind + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs)))) + +(defun erlang-xref-find-definitions-tag (kind + tag + arity + is-regexp + &optional xrefs) + "Find definitions of TAG preferably in local file and with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If no such local match was +found then look for a matching BIF in the same way. If IS-REGEXP +is non-nil then TAG is a regexp." + (let* ((regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (or xrefs + (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions regexp t)))) + (xrefs-split (erlang-split-xrefs xrefs)) + (local-xrefs (car xrefs-split)) + (local-xrefs (erlang-refine-xrefs local-xrefs + kind + tag + is-regexp)) + (bif-xrefs (cadr xrefs-split)) + (other-xrefs (caddr xrefs-split))) + (or (erlang-single-arity-match local-xrefs arity) + ;; No local match, look for a matching BIF. + (progn + (setq bif-xrefs (erlang-refine-xrefs bif-xrefs + kind + tag + is-regexp)) + (erlang-single-arity-match bif-xrefs arity)) + (progn + (setq other-xrefs (erlang-refine-xrefs other-xrefs + kind + tag + is-regexp)) + (and (null local-xrefs) + (null bif-xrefs) + ;; No local of BIF matches at all. Is there a single + ;; arity match among the rest? + (erlang-single-arity-match other-xrefs arity))) + (append (erlang-sort-by-arity local-xrefs arity) + (erlang-sort-by-arity bif-xrefs arity) + (erlang-sort-by-arity other-xrefs arity))))) + + +(defun erlang-refine-xrefs (xrefs kind tag is-regexp) + (if (or (memq kind '(record module)) + ;; No support for apropos here. + is-regexp + (erlang-too-many-files-in-xrefs xrefs)) + xrefs + (when (and xrefs + (fboundp 'xref-item-location) + (fboundp 'xref-location-group) + (fboundp 'slot-value)) + (let (files) + (cl-loop for xref in xrefs + for loc = (xref-item-location xref) + for file = (xref-location-group loc) + do (pushnew file files :test 'string-equal)) + (or (cl-loop for file in files + append (erlang-xrefs-in-file file kind tag is-regexp)) + ;; Failed for some reason. Pretend like it is raining and + ;; return the unrefined xrefs. + xrefs))))) + +(defun erlang-too-many-files-in-xrefs (xrefs) + (and erlang-max-files-to-visit-for-refining-xrefs + (let ((files-to-visit (delete-dups + (mapcar #'erlang-xref-truename-file + xrefs)))) + (if (< (length files-to-visit) + erlang-max-files-to-visit-for-refining-xrefs) + nil + (message (concat "Too many hits to consider arity (see " + "`erlang-max-files-to-visit-for-refining-xrefs')")) + t)))) + +(defun erlang-xrefs-in-file (file kind tag is-regexp) + (when (fboundp 'make-instance) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat ; "^" + (erlang-etags-regexp kind tag is-regexp) + "\\s *(")) + last-arity) + (cl-loop while (re-search-forward regexp nil t) + for name = (match-string-no-properties 1) + for arity = (save-excursion + (erlang-get-arity)) + for loc = (make-instance 'erlang-xref-location + :file file + :line (line-number-at-pos) + :column 0 + :arity arity) + for sum = (erlang-xref-summary kind name arity) + when (and arity + (not (eq arity last-arity))) + collect (make-instance 'xref-item + :summary sum + :location loc) + do (setq last-arity arity))))))) + +(defun erlang-xref-summary (kind tag arity) + (format "%s%s%s" + (if (memq kind '(record macro module)) + (format "%s " kind) + "") + tag + (if arity (format "/%s" arity) ""))) + +(defun erlang-single-arity-match (xrefs wanted-arity) + "Attempt to find one perfect match. + +If we have all information needed to consider arity then return a +single perfect match or nothing. If there are more than one +match nothing is returned. + +If we don't have all information needed to consider arity just +return XREFS as is." + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let ((nr-matches 0) + match) + (while (and xrefs + (< nr-matches 2)) + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (when (eq arity wanted-arity) + (setq match xref + nr-matches (1+ nr-matches))) + (setq xrefs (cdr xrefs)))) + (when (eq nr-matches 1) + (list match))) + (when (eq (length xrefs) 1) + xrefs))) + +(defun erlang-sort-by-arity (xrefs wanted-arity) + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let (matches non-matches) + (while xrefs + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (push xref (if (eq arity wanted-arity) + matches + non-matches)) + (setq xrefs (cdr xrefs)))) + (append (reverse matches) (reverse non-matches) xrefs)) + xrefs)) + +(defun erlang-should-consider-arity-p (xrefs wanted-arity) + (and wanted-arity + xrefs + (fboundp 'erlang-xref-location-p) + (fboundp 'xref-item-location) + (erlang-xref-location-p (xref-item-location (car xrefs))))) (defun erlang-etags-regexp (kind tag is-regexp) - (let ((tag-regexp (if is-regexp - tag - (regexp-quote tag)))) - (cond ((eq kind 'record) - (concat "-record\\s-*(\\s-*" tag-regexp)) - ((eq kind 'macro) - (concat "-define\\s-*(\\s-*" tag-regexp)) - (t tag-regexp)))) - + (let ((tag-regexp (concat "\\(" + (if is-regexp + tag + (regexp-quote tag)) + "\\)"))) + (concat (if is-regexp "" "^") + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t + tag-regexp)) + (if is-regexp "" "\\_>")))) + +(defun erlang-xref-arity (xref) + (and (fboundp 'erlang-xref-location-arity) + (fboundp 'xref-item-location) + (erlang-xref-location-arity (xref-item-location xref)))) + +(defun erlang-split-xrefs-on-module (xrefs module) + (let (local-xrefs non-local-xrefs) + (dolist (xref xrefs) + (if (string-equal (erlang-xref-module xref) + module) + (push xref local-xrefs) + (push xref non-local-xrefs))) + (cons (reverse local-xrefs) + (reverse non-local-xrefs)))) + +(defun erlang-split-xrefs (xrefs) + (let ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + local-xrefs bif-xrefs other-xrefs) + (dolist (xref xrefs) + (cond ((string-equal (erlang-xref-truename-file xref) current-file) + (push xref local-xrefs)) + ((string-equal (erlang-xref-module xref) "erlang") + (push xref bif-xrefs)) + (t + (push xref other-xrefs)))) + (list (reverse local-xrefs) + (reverse bif-xrefs) + (reverse other-xrefs)))) (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5113,7 +5289,13 @@ definitions in the currently visited file comes first." (fboundp 'xref-item-location) (xref-location-group (xref-item-location xref)))) - +(defun erlang-visit-tags-table-buffer (cont cbuf) + (if (< emacs-major-version 26) + (visit-tags-table-buffer cont) + ;; Remove this with-no-warnings when Emacs 26 is the required + ;; version minimum. + (with-no-warnings + (visit-tags-table-buffer cont cbuf)))) ;;; ;;; Prepare for other methods to run an Erlang slave process. 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 a6d43d1816..73270e6ed6 100644 --- a/lib/tools/test/emacs_SUITE.erl +++ b/lib/tools/test/emacs_SUITE.erl @@ -70,19 +70,20 @@ bif_highlight(Config) -> check_bif_highlight(Bin, Tag, Compare) -> - [_H,IntMatch,_T] = + [_H,Match,_T] = re:split(Bin,<<"defvar ",Tag/binary, "[^(]*\\(([^)]*)">>,[]), - EmacsIntBifs = [list_to_atom(S) || - S <- string:tokens(binary_to_list(IntMatch)," '\"\n")], + EmacsBifs = [list_to_atom(S) || + S <- string:tokens(binary_to_list(Match)," '\"\n")], - ct:log("Emacs ~p",[EmacsIntBifs]), - ct:log("Int ~p",[Compare]), + ct:log("Comparing ~s", [Tag]), + ct:log("Emacs ~p",[EmacsBifs]), + ct:log("Erlang ~p",[Compare]), - ct:log("Diff1 ~p",[Compare -- EmacsIntBifs]), - ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]), - [] = Compare -- EmacsIntBifs, - [] = EmacsIntBifs -- Compare. + ct:log("Only in Erlang ~p",[Compare -- EmacsBifs]), + ct:log("Only in Emacs ~p",[EmacsBifs -- Compare]), + [] = Compare -- EmacsBifs, + [] = EmacsBifs -- Compare. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -118,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), @@ -143,6 +144,10 @@ tests_compiled(_Config) -> ok end. + +dquote(Str) -> + "\"" ++ Str ++ "\"". + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% indent(Config) -> @@ -188,7 +193,9 @@ diff(Orig, File) -> end. emacs_version_ok(AcceptVer) -> - case os:cmd("emacs --version | head -1") of + VersionLine = os:cmd("emacs --version | head -1"), + io:format("~s~n", [VersionLine]), + case VersionLine of "GNU Emacs " ++ Ver -> case string:to_float(Ver) of {Vsn, _} when Vsn >= AcceptVer -> @@ -204,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]}. diff --git a/lib/wx/examples/simple/hello2.erl b/lib/wx/examples/simple/hello2.erl index 656c056d9a..07a9a56b7d 100644 --- a/lib/wx/examples/simple/hello2.erl +++ b/lib/wx/examples/simple/hello2.erl @@ -33,7 +33,7 @@ init/1, handle_info/2, handle_event/2, handle_call/3, code_change/3, terminate/2]). --behavoiur(wx_object). +-behaviour(wx_object). -record(state, {win}). |