diff options
Diffstat (limited to 'lib')
267 files changed, 10574 insertions, 4332 deletions
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index e495f587a3..152ece5d25 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -53,7 +53,8 @@ XML_REF3_FILES = ct.xml \ ct_slave.xml \ ct_property_test.xml \ ct_netconfc.xml \ - ct_hooks.xml + ct_hooks.xml \ + ct_testspec.xml XML_REF6_FILES = common_test_app.xml XML_PART_FILES = part.xml diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 48ffe653e4..d407a0a53f 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -224,7 +224,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:end_per_suite-1"><c>end_per_suite/1</c></seealso> + must also be defined.</p> <p>This configuration function is called as the first function in the suite. It typically contains initializations that are common for @@ -256,7 +258,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:init_per_suite-1"><c>init_per_suite/1</c></seealso> + must also be defined.</p> <p>This function is called as the last test case in the suite. It is meant to be used for cleaning up after @@ -360,7 +364,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:end_per_group-2"><c>end_per_group/2</c></seealso> + must also be defined.</p> <p>This configuration function is called before execution of a test case group. It typically contains initializations that are @@ -396,7 +402,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:init_per_group-2"><c>init_per_group/2</c></seealso> + must also be defined.</p> <p>This function is called after the execution of a test case group is finished. It is meant to be used for cleaning up after @@ -427,7 +435,10 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, + then <seealso marker="#Module:end_per_testcase-2"> + <c>end_per_testcase/2</c></seealso> must also be + defined.</p> <p>This function is called before each test case. Argument <c>TestCase</c> is the test case name, and @@ -454,7 +465,10 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, + then <seealso marker="#Module:init_per_testcase-2"> + <c>init_per_testcase/2</c></seealso> must also be + defined.</p> <p>This function is called after each test case, and can be used to clean up after diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index c2cf29c530..a085f30262 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -208,9 +208,10 @@ </func> <func> - <name>Module:pre_init_per_group(GroupName, InitData, CTHState) -> Result</name> + <name>Module:pre_init_per_group(SuiteName, GroupName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>InitData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -231,13 +232,19 @@ but for function <seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso> instead.</p> + + <p>If <c>Module:pre_init_per_group/4</c> is not exported, common_test + will attempt to call <c>Module:pre_init_per_group(GroupName, + InitData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_init_per_group(GroupName, Config, Return, CTHState) -> Result</name> + <name>Module:post_init_per_group(SuiteName, GroupName, Config, Return, CTHState) -> Result</name> <fsummary>Called after init_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -258,13 +265,19 @@ but for function <seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso> instead.</p> + + <p>If <c>Module:post_init_per_group/5</c> is not exported, common_test + will attempt to call <c>Module:post_init_per_group(GroupName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_init_per_testcase(TestcaseName, InitData, CTHState) -> Result</name> + <name>Module:pre_init_per_testcase(SuiteName, TestcaseName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>InitData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -286,6 +299,11 @@ <seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso> instead.</p> + <p>If <c>Module:pre_init_per_testcase/4</c> is not exported, common_test + will attempt to call <c>Module:pre_init_per_testcase(TestcaseName, + InitData, CTHState)</c> instead. This is for backwards + compatibility.</p> + <p>CTHs cannot be added here right now. That feature may be added in a later release, but it would right now break backwards compatibility.</p> @@ -293,9 +311,10 @@ </func> <func> - <name>Module:post_init_per_testcase(TestcaseName, Config, Return, CTHState) -> Result</name> + <name>Module:post_init_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -> Result</name> <fsummary>Called after init_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -316,15 +335,21 @@ but for function <seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso> instead.</p> + + <p>If <c>Module:post_init_per_testcase/5</c> is not exported, common_test + will attempt to call <c>Module:post_init_per_testcase(TestcaseName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_end_per_testcase(TestcaseName, InitData, CTHState) -> Result</name> + <name>Module:pre_end_per_testcase(SuiteName, TestcaseName, EndData, CTHState) -> Result</name> <fsummary>Called before end_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> - <v>InitData = Config</v> + <v>EndData = Config</v> <v>Config = NewConfig = [{Key,Value}]</v> <v>CTHState = NewCTHState = term()</v> <v>Result = {NewConfig, NewCTHState}</v> @@ -345,14 +370,20 @@ <p>This function can not change the result of the test case by returning skip or fail tuples, but it may insert items in <c>Config</c> that can be read in - <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/4</c>.</p> + <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/5</c>.</p> + + <p>If <c>Module:pre_end_per_testcase/4</c> is not exported, common_test + will attempt to call <c>Module:pre_end_per_testcase(TestcaseName, + EndData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_end_per_testcase(TestcaseName, Config, Return, CTHState) -> Result</name> + <name>Module:post_end_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -> Result</name> <fsummary>Called after end_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -373,13 +404,19 @@ but for function <seealso marker="common_test#Module:end_per_testcase-2"><c>end_per_testcase</c></seealso> instead.</p> + + <p>If <c>Module:post_end_per_testcase/5</c> is not exported, common_test + will attempt to call <c>Module:post_end_per_testcase(TestcaseName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_end_per_group(GroupName, EndData, CTHState) -> Result</name> + <name>Module:pre_end_per_group(SuiteName, GroupName, EndData, CTHState) -> Result</name> <fsummary>Called before end_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>EndData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -400,13 +437,19 @@ but for function <seealso marker="common_test#Module:end_per_group-2"><c>end_per_group</c></seealso> instead.</p> + + <p>If <c>Module:pre_end_per_group/4</c> is not exported, common_test + will attempt to call <c>Module:pre_end_per_group(GroupName, + EndData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_end_per_group(GroupName, Config, Return, CTHState) -> Result</name> + <name>Module:post_end_per_group(SuiteName, GroupName, Config, Return, CTHState) -> Result</name> <fsummary>Called after end_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -427,6 +470,11 @@ but for function <seealso marker="common_test#Module:end_per_group-2">end_per_group</seealso> instead.</p> + + <p>If <c>Module:post_end_per_group/5</c> is not exported, common_test + will attempt to call <c>Module:post_end_per_group(GroupName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> @@ -485,9 +533,10 @@ </func> <func> - <name>Module:on_tc_fail(TestName, Reason, CTHState) -> NewCTHState</name> + <name>Module:on_tc_fail(SuiteName, TestName, Reason, CTHState) -> NewCTHState</name> <fsummary>Called after the CTH scope ends.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v> <v>FuncName = atom()</v> <v>GroupName = atom()</v> @@ -505,7 +554,7 @@ <item><p>If <c>init_per_suite</c> fails, this function is called after <seealso marker="#Module:post_init_per_suite-4"><c>post_init_per_suite</c></seealso>.</p></item> <item><p>If a test case fails, this funcion is called after - <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item> + <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item> </list> <p>If the failed test case belongs to a test case group, the first @@ -519,13 +568,19 @@ For details, see section <seealso marker="event_handler_chapter#events">Event Handling</seealso> in the User's Guide.</p> + + <p>If <c>Module:on_tc_fail/4</c> is not exported, common_test + will attempt to call <c>Module:on_tc_fail(TestName, Reason, + CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:on_tc_skip(TestName, Reason, CTHState) -> NewCTHState</name> + <name>Module:on_tc_skip(SuiteName, TestName, Reason, CTHState) -> NewCTHState</name> <fsummary>Called after the CTH scope ends.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v> <v>FuncName = atom()</v> <v>GroupName = atom()</v> @@ -542,9 +597,9 @@ <list type="bulleted"> <item><p>If <c>init_per_group</c> is skipped, this function is called after - <seealso marker="#Module:post_init_per_group-4"><c>post_init_per_group</c></seealso>.</p></item> + <seealso marker="#Module:post_init_per_group-5"><c>post_init_per_group</c></seealso>.</p></item> <item><p>If a test case is skipped, this function is called after - <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item> + <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item> </list> <p>If the skipped test case belongs to a test case group, the first @@ -559,6 +614,11 @@ For details, see section <seealso marker="event_handler_chapter#events">Event Handling</seealso> in the User's Guide.</p> + + <p>If <c>Module:on_tc_skip/4</c> is not exported, common_test + will attempt to call <c>Module:on_tc_skip(TestName, Reason, + CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index 0e4c35e11f..bfad96e489 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -38,7 +38,7 @@ extensions of the default behavior of <c>Common Test</c> using hooks before and after all test suite calls. CTHs allow advanced <c>Common Test</c> users to abstract out behavior that is common to multiple test suites - without littering all test suites with library calls. this can be used + without littering all test suites with library calls. This can be used for logging, starting, and monitoring external systems, building C files needed by the tests, and so on.</p> @@ -175,10 +175,10 @@ <row> <cell><seealso marker="common_test#Module:init_per_group-2"> init_per_group/2</seealso></cell> - <cell><seealso marker="ct_hooks#Module:post_init_per_group-4"> - post_init_per_group/4</seealso> is called</cell> - <cell><seealso marker="ct_hooks#Module:post_end_per_suite-4"> - post_end_per_group/4</seealso> has been called for that group</cell> + <cell><seealso marker="ct_hooks#Module:post_init_per_group-5"> + post_init_per_group/5</seealso> is called</cell> + <cell><seealso marker="ct_hooks#Module:post_end_per_group-5"> + post_end_per_group/5</seealso> has been called for that group</cell> </row> <tcaption>Scope of a CTH</tcaption> </table> @@ -245,16 +245,18 @@ </list> <p> - This is done in the CTH functions called pre_<name of function>. - These functions take the same three arguments, <c>Name</c>, + This is done in the CTH functions called <c>pre_<name of function></c>. + These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable), <c>Config</c>, and <c>CTHState</c>. The return value of the CTH function is always a combination of a result for the suite/group/test and an updated <c>CTHState</c>.</p> <p>To let the test suite continue on executing, return the configuration - list that you want the test to use as the result. To skip or - fail the test, return a tuple with <c>skip</c> or <c>fail</c>, and a reason - as the result.</p> + list that you want the test to use as the result.</p> + + <p>All pre hooks, except <c>pre_end_per_testcase/4</c>, can + skip or fail the test by returning a tuple with <c>skip</c> or + <c>fail</c>, and a reason as the result.</p> <p><em>Example:</em></p> <code> @@ -290,7 +292,7 @@ <p> This is done in the CTH functions called <c>post_<name of function></c>. - These functions take the same four arguments, <c>Name</c>, + These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable), <c>Config</c>, <c>Return</c>, and <c>CTHState</c>. <c>Config</c> in this case is the same <c>Config</c> as the testcase is called with. <c>Return</c> is the value returned by the testcase. If the testcase @@ -308,7 +310,7 @@ <p><em>Example:</em></p> <code> - post_end_per_testcase(_TC, Config, {'EXIT',{_,_}}, CTHState) -> + post_end_per_testcase(_Suite, _TC, Config, {'EXIT',{_,_}}, CTHState) -> case db:check_consistency() of true -> %% DB is good, pass the test. @@ -317,7 +319,7 @@ %% DB is not good, mark as skipped instead of failing {{skip, "DB is inconsisten!"}, CTHState} end; - post_end_per_testcase(_TC, Config, Return, CTHState) -> + post_end_per_testcase(_Suite, _TC, Config, Return, CTHState) -> %% Do nothing if tc does not crash. {Return, CTHState}.</code> @@ -331,8 +333,8 @@ <title>Skip and Fail Hooks</title> <p> After any post hook has been executed for all installed CTHs, - <seealso marker="ct_hooks#Module:on_tc_fail-3">on_tc_fail</seealso> - or <seealso marker="ct_hooks#Module:on_tc_skip-3">on_tc_skip</seealso> + <seealso marker="ct_hooks#Module:on_tc_fail-4">on_tc_fail</seealso> + or <seealso marker="ct_hooks#Module:on_tc_skip-4">on_tc_skip</seealso> is called if the testcase failed or was skipped, respectively. You cannot affect the outcome of the tests any further at this point. </p> @@ -389,18 +391,18 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). - -export([pre_init_per_group/3]). - -export([post_init_per_group/4]). - -export([pre_end_per_group/3]). - -export([post_end_per_group/4]). + -export([pre_init_per_group/4]). + -export([post_init_per_group/5]). + -export([pre_end_per_group/4]). + -export([post_end_per_group/5]). - -export([pre_init_per_testcase/3]). - -export([post_init_per_testcase/4]). - -export([pre_end_per_testcase/3]). - -export([post_end_per_testcase/4]). + -export([pre_init_per_testcase/4]). + -export([post_init_per_testcase/5]). + -export([pre_end_per_testcase/4]). + -export([post_end_per_testcase/5]). - -export([on_tc_fail/3]). - -export([on_tc_skip/3]). + -export([on_tc_fail/4]). + -export([on_tc_skip/4]). -export([terminate/1]). @@ -435,46 +437,46 @@ total = State#state.total + State#state.suite_total } }. %% @doc Called before each init_per_group. - pre_init_per_group(Group,Config,State) -> + pre_init_per_group(Suite,Group,Config,State) -> {Config, State}. %% @doc Called after each init_per_group. - post_init_per_group(Group,Config,Return,State) -> + post_init_per_group(Suite,Group,Config,Return,State) -> {Return, State}. %% @doc Called before each end_per_group. - pre_end_per_group(Group,Config,State) -> + pre_end_per_group(Suite,Group,Config,State) -> {Config, State}. %% @doc Called after each end_per_group. - post_end_per_group(Group,Config,Return,State) -> + post_end_per_group(Suite,Group,Config,Return,State) -> {Return, State}. %% @doc Called before each init_per_testcase. - pre_init_per_testcase(TC,Config,State) -> + pre_init_per_testcase(Suite,TC,Config,State) -> {Config, State#state{ ts = now(), total = State#state.suite_total + 1 } }. %% Called after each init_per_testcase (immediately before the test case). - post_init_per_testcase(TC,Config,Return,State) -> + post_init_per_testcase(Suite,TC,Config,Return,State) -> {Return, State} %% @doc Called before each end_per_testcase (immediately after the test case). - pre_end_per_testcase(TC,Config,State) -> + pre_end_per_testcase(Suite,TC,Config,State) -> {Config, State}. %% @doc Called after each end_per_testcase. - post_end_per_testcase(TC,Config,Return,State) -> - TCInfo = {testcase, TC, Return, timer:now_diff(now(), State#state.ts)}, + post_end_per_testcase(Suite,TC,Config,Return,State) -> + TCInfo = {testcase, Suite, TC, Return, timer:now_diff(now(), State#state.ts)}, {Return, State#state{ ts = undefined, tcs = [TCInfo | State#state.tcs] } }. %% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group, %% post_end_per_group and post_end_per_testcase if the suite, group or test case failed. - on_tc_fail(TC, Reason, State) -> + on_tc_fail(Suite, TC, Reason, State) -> State. %% @doc Called when a test case is skipped by either user action %% or due to an init function failing. - on_tc_skip(TC, Reason, State) -> + on_tc_skip(Suite, TC, Reason, State) -> State. %% @doc Called when the scope of the CTH is done diff --git a/lib/common_test/doc/src/ct_testspec.xml b/lib/common_test/doc/src/ct_testspec.xml new file mode 100644 index 0000000000..36893f66cf --- /dev/null +++ b/lib/common_test/doc/src/ct_testspec.xml @@ -0,0 +1,84 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>ct_testspec</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev>A</rev> + <file>ct_testspec.xml</file> + </header> + <module>ct_testspec</module> + <modulesummary>Parsing of test specifications for Common Test. + </modulesummary> + +<description> + + <p>Parsing of test specifications for <c>Common Test</c>.</p> + + <p>This module exports help functions for parsing of test specifications.</p> + +</description> + + <funcs> + <func> + <name>get_tests(SpecsIn) -> {ok, [{Specs,Tests}]} | {error, Reason}</name> + <fsummary>Parse the given test specification files and return the tests to run and skip.</fsummary> + <type> + <v>SpecsIn = [string()] | [[string()]]</v> + <v>Specs = [string()]</v> + <v>Test = [{Node,Run,Skip}]</v> + <v>Node = atom()</v> + <v>Run = {Dir,Suites,Cases}</v> + <v>Skip = {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}</v> + <v>Dir = string()</v> + <v>Suites = atom | [atom()] | all</v> + <v>Cases = atom | [atom()] | all</v> + <v>Comment = string()</v> + <v>Reason = term()</v> + </type> + <desc><marker id="add_nodes-1"/> + <p>Parse the given test specification files and return the + tests to run and skip.</p> + + <p>If <c>SpecsIn=[Spec1,Spec2,...]</c>, separate tests will be + created per specification. If + <c>SpecsIn=[[Spec1,Spec2,...]]</c>, all specifications will be + merge into one test.</p> + + <p>For each test, a <c>{Specs,Tests}</c> element is returned, + where <c>Specs</c> is a list of all included test + specifications, and <c>Tests</c> specifies actual tests to + run/skip per node.</p> + </desc> + </func> + + </funcs> + +</erlref> + + diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index d1567e2d3c..1ac20db5c2 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -47,6 +47,7 @@ <xi:include href="ct_slave.xml"/> <xi:include href="ct_hooks.xml"/> <xi:include href="ct_property_test.xml"/> + <xi:include href="ct_testspec.xml"/> </application> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index f70bdb16c5..6a0d87bcaf 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -566,7 +566,7 @@ for the test cases in the group. After execution of the group is finished, function <seealso marker="common_test#Module:end_per_group-2"><c>end_per_group(GroupName, Config)</c></seealso> is called. This function is meant to be used for cleaning up after - <c>init_per_group/2</c>.</p> + <c>init_per_group/2</c>. If the init function is defined, so must the end function be.</p> <p>Whenever a group is executed, if <c>init_per_group</c> and <c>end_per_group</c> do not exist in the suite, <c>Common Test</c> calls diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 77588af59b..dfa321c901 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -22,6 +22,7 @@ {vsn, "%VSN%"}, {modules, [ct_cover, ct, + ct_default_gl, ct_event, ct_framework, ct_ftp, diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 291a4d716c..43f1c9de0f 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -52,6 +52,10 @@ %%% %%% @doc Test server framework callback, called by the test_server %%% when a new test case is started. +init_tc(_,{end_per_testcase_not_run,_},[Config]) -> + %% Testcase is completed (skipped or failed), but end_per_testcase + %% is not run - don't call pre-hook. + {ok,[Config]}; init_tc(Mod,EPTC={end_per_testcase,_},[Config]) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Config), @@ -62,7 +66,7 @@ init_tc(Mod,EPTC={end_per_testcase,_},[Config]) -> Other end; -init_tc(Mod,Func0,Args) -> +init_tc(Mod,Func0,Args) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), {Func,HookFunc} = case Func0 of @@ -84,12 +88,15 @@ init_tc(Mod,Func0,Args) -> andalso Func=/=end_per_group andalso ct_util:get_testdata(skip_rest) of true -> + initialize(false,Mod,Func,Args), {auto_skip,"Repeated test stopped by force_stop option"}; _ -> case ct_util:get_testdata(curr_tc) of {Suite,{suite0_failed,{require,Reason}}} -> + initialize(false,Mod,Func,Args), {auto_skip,{require_failed_in_suite0,Reason}}; {Suite,{suite0_failed,_}=Failure} -> + initialize(false,Mod,Func,Args), {fail,Failure}; _ -> ct_util:update_testdata(curr_tc, @@ -118,16 +125,14 @@ init_tc(Mod,Func0,Args) -> end, init_tc1(Mod,Suite,Func,HookFunc,Args); {failed,Seq,BadFunc} -> - {auto_skip,{sequence_failed,Seq,BadFunc}} + initialize(false,Mod,Func,Args), + {auto_skip,{sequence_failed,Seq,BadFunc}} end end end. init_tc1(?MODULE,_,error_in_suite,_,[Config0]) when is_list(Config0) -> - ct_logs:init_tc(false), - ct_event:notify(#event{name=tc_start, - node=node(), - data={?MODULE,error_in_suite}}), + initialize(false,?MODULE,error_in_suite), _ = ct_suite_init(?MODULE,error_in_suite,[],Config0), case ?val(error,Config0) of undefined -> @@ -177,27 +182,21 @@ init_tc1(Mod,Suite,Func,HookFunc,[Config0]) when is_list(Config0) -> ct_config:delete_default_config(testcase), HookFunc end, - Initialize = fun() -> - ct_logs:init_tc(false), - ct_event:notify(#event{name=tc_start, - node=node(), - data={Mod,FuncSpec}}) - end, case add_defaults(Mod,Func,AllGroups) of Error = {suite0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), ct_util:set_testdata({curr_tc,{Suite,Error}}), {error,Error}; Error = {group0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), {auto_skip,Error}; Error = {testcase0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), {auto_skip,Error}; {SuiteInfo,MergeResult} -> case MergeResult of {error,Reason} -> - Initialize(), + initialize(false,Mod,FuncSpec), {fail,Reason}; _ -> init_tc2(Mod,Suite,Func,HookFunc1, @@ -236,11 +235,8 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) -> Conns -> ct_util:silence_connections(Conns) end, - ct_logs:init_tc(Func == init_per_suite), FuncSpec = group_or_func(Func,Config), - ct_event:notify(#event{name=tc_start, - node=node(), - data={Mod,FuncSpec}}), + initialize((Func==init_per_suite),Mod,FuncSpec), case catch configure(MergedInfo,MergedInfo,SuiteInfo, FuncSpec,[],Config) of @@ -268,6 +264,18 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) -> end end. +initialize(RefreshLogs,Mod,Func,[Config]) when is_list(Config) -> + initialize(RefreshLogs,Mod,group_or_func(Func,Config)); +initialize(RefreshLogs,Mod,Func,_) -> + initialize(RefreshLogs,Mod,Func). + +initialize(RefreshLogs,Mod,FuncSpec) -> + ct_logs:init_tc(RefreshLogs), + ct_event:notify(#event{name=tc_start, + node=node(), + data={Mod,FuncSpec}}). + + ct_suite_init(Suite,HookFunc,PostInitHook,Config) when is_list(Config) -> case ct_hooks:init_tc(Suite,HookFunc,Config) of NewConfig when is_list(NewConfig) -> @@ -675,22 +683,35 @@ end_tc(Mod,Func,{Result,[Args]}, Return) -> end_tc(Mod,Func,self(),Result,Args,Return). end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) -> - %% in case Mod == ct_framework, lookup the suite name - Suite = get_suite_name(Mod, Args), - case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of - '$ct_no_change' -> - ok; - HookResult -> - HookResult + case end_hook_func(IPTC,Return,IPTC) of + undefined -> ok; + _ -> + %% in case Mod == ct_framework, lookup the suite name + Suite = get_suite_name(Mod, Args), + case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of + '$ct_no_change' -> + ok; + HookResult -> + HookResult + end end; end_tc(Mod,Func0,TCPid,Result,Args,Return) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), - {EPTC,Func} = case Func0 of - {end_per_testcase,F} -> {true,F}; - _ -> {false,Func0} - end, + {Func,FuncSpec,HookFunc} = + case Func0 of + {end_per_testcase_not_run,F} -> + %% Testcase is completed (skipped or failed), but + %% end_per_testcase is not run - don't call post-hook. + {F,F,undefined}; + {end_per_testcase,F} -> + {F,F,Func0}; + _ -> + FS = group_or_func(Func0,Args), + HF = end_hook_func(Func0,Return,FS), + {Func0,FS,HF} + end, test_server:timetrap_cancel(), @@ -717,20 +738,18 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, ct_util:delete_suite_data(last_saved_config), - {FuncSpec,HookFunc} = - if not EPTC -> - FS = group_or_func(Func,Args), - {FS,FS}; - true -> - {Func,Func0} - end, {Result1,FinalNotify} = - case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of - '$ct_no_change' -> - {ok,Result}; - HookResult -> - {HookResult,HookResult} - end, + case HookFunc of + undefined -> + {ok,Result}; + _ -> + case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of + '$ct_no_change' -> + {ok,Result}; + HookResult -> + {HookResult,HookResult} + end + end, FinalResult = case get('$test_server_framework_test') of undefined -> @@ -821,6 +840,34 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, FinalResult. +%% This is to make sure that no post_init_per_* is ever called if the +%% corresponding pre_init_per_* was not called. +%% The skip or fail reasons are those that can be returned from +%% init_tc above in situations where we never came to call +%% ct_hooks:init_tc/3, e.g. if suite/0 fails, then we never call +%% ct_hooks:init_tc for init_per_suite, and thus we must not call +%% ct_hooks:end_tc for init_per_suite either. +end_hook_func({init_per_testcase,_},{auto_skip,{sequence_failed,_,_}},_) -> + undefined; +end_hook_func({init_per_testcase,_},{auto_skip,"Repeated test stopped by force_stop option"},_) -> + undefined; +end_hook_func({init_per_testcase,_},{fail,{config_name_already_in_use,_}},_) -> + undefined; +end_hook_func({init_per_testcase,_},{auto_skip,{InfoFuncError,_}},_) + when InfoFuncError==testcase0_failed; + InfoFuncError==require_failed -> + undefined; +end_hook_func(init_per_group,{auto_skip,{InfoFuncError,_}},_) + when InfoFuncError==group0_failed; + InfoFuncError==require_failed -> + undefined; +end_hook_func(init_per_suite,{auto_skip,{require_failed_in_suite0,_}},_) -> + undefined; +end_hook_func(init_per_suite,{auto_skip,{failed,{error,{suite0_failed,_}}}},_) -> + undefined; +end_hook_func(_,_,Default) -> + Default. + %% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | %% {testcase_aborted,Reason} | testcase_aborted_or_killed | %% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} | @@ -1339,25 +1386,25 @@ report(What,Data) -> ok; tc_done -> {Suite,{Func,GrName},Result} = Data, - Data1 = if GrName == undefined -> {Suite,Func,Result}; - true -> Data - end, + FuncSpec = if GrName == undefined -> Func; + true -> {Func,GrName} + end, %% Register the group leader for the process calling the report %% function, making it possible for a hook function to print %% in the test case log file ReportingPid = self(), ct_logs:register_groupleader(ReportingPid, group_leader()), case Result of - {failed, _} -> - ct_hooks:on_tc_fail(What, Data1); - {skipped,{failed,{_,init_per_testcase,_}}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); - {skipped,{require_failed,_}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); - {skipped,_} -> - ct_hooks:on_tc_skip(tc_user_skip, Data1); - {auto_skipped,_} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); + {failed, Reason} -> + ct_hooks:on_tc_fail(What, {Suite,FuncSpec,Reason}); + {skipped,{failed,{_,init_per_testcase,_}}=Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); + {skipped,{require_failed,_}=Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); + {skipped,Reason} -> + ct_hooks:on_tc_skip(tc_user_skip, {Suite,FuncSpec,Reason}); + {auto_skipped,Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); _Else -> ok end, diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index 1375e7dcc7..1c9faf6a70 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -442,17 +442,21 @@ make_conf(Mod, Name, Props, TestSpec) -> ok end, {InitConf,EndConf,ExtraProps} = - case erlang:function_exported(Mod,init_per_group,2) of - true -> - {{Mod,init_per_group},{Mod,end_per_group},[]}; - false -> + case {erlang:function_exported(Mod,init_per_group,2), + erlang:function_exported(Mod,end_per_group,2)} of + {false,false} -> ct_logs:log("TEST INFO", "init_per_group/2 and " "end_per_group/2 missing for group " "~w in ~w, using default.", [Name,Mod]), {{ct_framework,init_per_group}, {ct_framework,end_per_group}, - [{suite,Mod}]} + [{suite,Mod}]}; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + {{Mod,init_per_group},{Mod,end_per_group},[]} end, {conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}. diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index c9a4abb5ee..60d1ea2b1c 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -92,15 +92,17 @@ init_tc(Mod, end_per_suite, Config) -> call(fun call_generic/3, Config, [pre_end_per_suite, Mod]); init_tc(Mod, {init_per_group, GroupName, Properties}, Config) -> maybe_start_locker(Mod, GroupName, Properties), - call(fun call_generic/3, Config, [pre_init_per_group, GroupName]); -init_tc(_Mod, {end_per_group, GroupName, _}, Config) -> - call(fun call_generic/3, Config, [pre_end_per_group, GroupName]); -init_tc(_Mod, {init_per_testcase,TC}, Config) -> - call(fun call_generic/3, Config, [pre_init_per_testcase, TC]); -init_tc(_Mod, {end_per_testcase,TC}, Config) -> - call(fun call_generic/3, Config, [pre_end_per_testcase, TC]); -init_tc(_Mod, TC = error_in_suite, Config) -> - call(fun call_generic/3, Config, [pre_init_per_testcase, TC]). + call(fun call_generic_fallback/3, Config, + [pre_init_per_group, Mod, GroupName]); +init_tc(Mod, {end_per_group, GroupName, _}, Config) -> + call(fun call_generic_fallback/3, Config, + [pre_end_per_group, Mod, GroupName]); +init_tc(Mod, {init_per_testcase,TC}, Config) -> + call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]); +init_tc(Mod, {end_per_testcase,TC}, Config) -> + call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]); +init_tc(Mod, TC = error_in_suite, Config) -> + call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]). %% @doc Called as each test case is completed. This includes all configuration %% tests. @@ -126,23 +128,23 @@ end_tc(Mod, init_per_suite, Config, _Result, Return) -> end_tc(Mod, end_per_suite, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config], '$ct_no_change'); -end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> - call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config], - '$ct_no_change'); +end_tc(Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> + call(fun call_generic_fallback/3, Return, + [post_init_per_group, Mod, GroupName, Config], '$ct_no_change'); end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) -> - Res = call(fun call_generic/3, Result, - [post_end_per_group, GroupName, Config], '$ct_no_change'), + Res = call(fun call_generic_fallback/3, Result, + [post_end_per_group, Mod, GroupName, Config], '$ct_no_change'), maybe_stop_locker(Mod, GroupName, Properties), Res; -end_tc(_Mod, {init_per_testcase,TC}, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_init_per_testcase, TC, Config], - '$ct_no_change'); -end_tc(_Mod, {end_per_testcase,TC}, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], - '$ct_no_change'); -end_tc(_Mod, TC = error_in_suite, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], - '$ct_no_change'). +end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_init_per_testcase, Mod, TC, Config], '$ct_no_change'); +end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_end_per_testcase, Mod, TC, Config], '$ct_no_change'); +end_tc(Mod, TC = error_in_suite, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_end_per_testcase, Mod, TC, Config], '$ct_no_change'). %% Case = TestCase | {TestCase,GroupName} @@ -181,15 +183,21 @@ call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) -> {[],Hook}. call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook, - Reason, [Function, _Suite | Args]) -> + Reason, [Function | Args]) -> NewState = catch_apply(Mod,Function, Args ++ [Reason, State], - State), + State, true), {Reason, Hook#ct_hook_config{ state = NewState } }. -call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, - Value, [Function | Args]) -> +call_generic(Hook, Value, Meta) -> + do_call_generic(Hook, Value, Meta, false). + +call_generic_fallback(Hook, Value, Meta) -> + do_call_generic(Hook, Value, Meta, true). + +do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, + Value, [Function | Args], Fallback) -> {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], - {Value,State}), + {Value,State}, Fallback), {NewValue, Hook#ct_hook_config{ state = NewState } }. %% Generic call function @@ -257,15 +265,15 @@ remove(Key,List) when is_list(List) -> remove(_, Else) -> Else. -%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc -scope([pre_init_per_testcase, TC|_]) -> - [post_init_per_testcase, TC]; -scope([pre_end_per_testcase, TC|_]) -> - [post_end_per_testcase, TC]; -scope([pre_init_per_group, GroupName|_]) -> - [post_end_per_group, GroupName]; -scope([post_init_per_group, GroupName|_]) -> - [post_end_per_group, GroupName]; +%% Translate scopes, i.e. is_tuplenit_per_group,group1 -> end_per_group,group1 etc +scope([pre_init_per_testcase, SuiteName, TC|_]) -> + [post_init_per_testcase, SuiteName, TC]; +scope([pre_end_per_testcase, SuiteName, TC|_]) -> + [post_end_per_testcase, SuiteName, TC]; +scope([pre_init_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; +scope([post_init_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; scope([pre_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; scope([post_init_per_suite, SuiteName|_]) -> @@ -273,14 +281,29 @@ scope([post_init_per_suite, SuiteName|_]) -> scope(init) -> none. -terminate_if_scope_ends(HookId, [on_tc_skip,_Suite,{end_per_group,Name}], +strip_config([post_init_per_testcase, SuiteName, TC|_]) -> + [post_init_per_testcase, SuiteName, TC]; +strip_config([post_end_per_testcase, SuiteName, TC|_]) -> + [post_end_per_testcase, SuiteName, TC]; +strip_config([post_init_per_group, SuiteName, GroupName|_]) -> + [post_init_per_group, SuiteName, GroupName]; +strip_config([post_end_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; +strip_config([post_init_per_suite, SuiteName|_]) -> + [post_init_per_suite, SuiteName]; +strip_config([post_end_per_suite, SuiteName|_]) -> + [post_end_per_suite, SuiteName]; +strip_config(Other) -> + Other. + + +terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}], Hooks) -> - terminate_if_scope_ends(HookId, [post_end_per_group, Name], Hooks); + terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks); terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) -> terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks); -terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] -> - terminate_if_scope_ends(HookId,[Function,Tag],Hooks); -terminate_if_scope_ends(HookId, Function, Hooks) -> +terminate_if_scope_ends(HookId, Function0, Hooks) -> + Function = strip_config(Function0), case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of #ct_hook_config{ id = HookId, scope = Function} = Hook -> terminate([Hook]), @@ -384,21 +407,29 @@ pos(Id,[_|Rest],Num) -> catch_apply(M,F,A, Default) -> + catch_apply(M,F,A,Default,false). +catch_apply(M,F,A, Default, Fallback) -> + not erlang:module_loaded(M) andalso (catch M:module_info()), + case erlang:function_exported(M,F,length(A)) of + false when Fallback -> + catch_apply(M,F,tl(A),Default,false); + false -> + Default; + true -> + catch_apply(M,F,A) + end. + +catch_apply(M,F,A) -> try - erlang:apply(M,F,A) + erlang:apply(M,F,A) catch _:Reason -> - case erlang:get_stacktrace() of - %% Return the default if it was the CTH module which did not have the function. - [{M,F,A,_}|_] when Reason == undef -> - Default; - Trace -> - ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p", - [error,{Reason,Trace}]), - throw({error_in_cth_call, - lists:flatten( - io_lib:format("~w:~w/~w CTH call failed", - [M,F,length(A)]))}) - end + Trace = erlang:get_stacktrace(), + ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p", + [error,{Reason,Trace}]), + throw({error_in_cth_call, + lists:flatten( + io_lib:format("~w:~w/~w CTH call failed", + [M,F,length(A)]))}) end. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index a049ef5695..cac176de3a 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -76,8 +76,8 @@ abort_if_missing_suites, silent_connections = [], stylesheet, - multiply_timetraps = 1, - scale_timetraps = false, + multiply_timetraps, + scale_timetraps, create_priv_dir, testspec_files = [], current_testspec, @@ -264,11 +264,11 @@ script_start1(Parent, Args) -> [], Args), Verbosity = verbosity_args2opts(Args), MultTT = get_start_opt(multiply_timetraps, - fun([MT]) -> list_to_integer(MT) end, 1, Args), + fun([MT]) -> list_to_integer(MT) end, Args), ScaleTT = get_start_opt(scale_timetraps, fun([CT]) -> list_to_atom(CT); ([]) -> true - end, false, Args), + end, Args), CreatePrivDir = get_start_opt(create_priv_dir, fun([PD]) -> list_to_atom(PD); ([]) -> auto_per_tc @@ -1055,8 +1055,8 @@ run_test2(StartOpts) -> CoverStop = get_start_opt(cover_stop, value, StartOpts), %% timetrap manipulation - MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts), - ScaleTT = get_start_opt(scale_timetraps, value, false, StartOpts), + MultiplyTT = get_start_opt(multiply_timetraps, value, StartOpts), + ScaleTT = get_start_opt(scale_timetraps, value, StartOpts), %% create unique priv dir names CreatePrivDir = get_start_opt(create_priv_dir, value, StartOpts), @@ -2280,8 +2280,19 @@ do_run_test(Tests, Skip, Opts0) -> _Lower -> ok end, - test_server_ctrl:multiply_timetraps(Opts0#opts.multiply_timetraps), - test_server_ctrl:scale_timetraps(Opts0#opts.scale_timetraps), + + case Opts0#opts.multiply_timetraps of + undefined -> MultTT = 1; + MultTT -> MultTT + end, + case Opts0#opts.scale_timetraps of + undefined -> ScaleTT = false; + ScaleTT -> ScaleTT + end, + ct_logs:log("TEST INFO","Timetrap time multiplier = ~w~n" + "Timetrap scaling enabled = ~w", [MultTT,ScaleTT]), + test_server_ctrl:multiply_timetraps(MultTT), + test_server_ctrl:scale_timetraps(ScaleTT), test_server_ctrl:create_priv_dir(choose_val( Opts0#opts.create_priv_dir, diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 991abb0666..466a2c7658 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -26,7 +26,8 @@ -export([prepare_tests/1, prepare_tests/2, collect_tests_from_list/2, collect_tests_from_list/3, - collect_tests_from_file/2, collect_tests_from_file/3]). + collect_tests_from_file/2, collect_tests_from_file/3, + get_tests/1]). -export([testspec_rec2list/1, testspec_rec2list/2]). @@ -803,6 +804,31 @@ list_nodes(#testspec{nodes=NodeRefs}) -> lists:map(fun({_Ref,Node}) -> Node end, NodeRefs). +%%%----------------------------------------------------------------- +%%% Parse the given test specs and return the complete set of specs +%%% and tests to run/skip. +%%% [Spec1,Spec2,...] means create separate tests per spec +%%% [[Spec1,Spec2,...]] means merge all specs into one +-spec get_tests(Specs) -> {ok,[{Specs,Tests}]} | {error,Reason} when + Specs :: [string()] | [[string()]], + Tests :: {Node,Run,Skip}, + Node :: atom(), + Run :: {Dir,Suites,Cases}, + Skip :: {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}, + Dir :: string(), + Suites :: atom | [atom()] | all, + Cases :: atom | [atom()] | all, + Comment :: string(), + Reason :: term(). + +get_tests(Specs) -> + case collect_tests_from_file(Specs,true) of + Tests when is_list(Tests) -> + {ok,[{S,prepare_tests(R)} || {S,R} <- Tests]}; + Error -> + Error + end. + %% ----------------------------------------------------- %% / \ %% | When adding test/config terms, remember to update | @@ -1132,6 +1158,11 @@ handle_data(verbosity,Node,VLvls,_Spec) when is_list(VLvls) -> VLvls1 = lists:map(fun(VLvl = {_Cat,_Lvl}) -> VLvl; (Lvl) -> {'$unspecified',Lvl} end, VLvls), [{Node,VLvls1}]; +handle_data(multiply_timetraps,Node,Mult,_Spec) when is_integer(Mult) -> + [{Node,Mult}]; +handle_data(scale_timetraps,Node,Scale,_Spec) when Scale == true; + Scale == false -> + [{Node,Scale}]; handle_data(silent_connections,Node,all,_Spec) -> [{Node,[all]}]; handle_data(silent_connections,Node,Conn,_Spec) when is_atom(Conn) -> @@ -1150,6 +1181,8 @@ should_be_added(Tag,Node,_Data,Spec) -> Tag == label; Tag == auto_compile; Tag == abort_if_missing_suites; Tag == stylesheet; Tag == verbosity; + Tag == multiply_timetraps; + Tag == scale_timetraps; Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, read_field(Spec,Tag)) == false; diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index 883da0da0a..ce8852b3ea 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -54,8 +54,8 @@ -include_lib("common_test/include/ct.hrl"). -export([init/2, - pre_init_per_testcase/3, - post_end_per_testcase/4]). + pre_init_per_testcase/4, + post_end_per_testcase/5]). %%---------------------------------------------------------------------- %% Exported types @@ -104,7 +104,7 @@ get_log_opts(Mod,Opts) -> Hosts = proplists:get_value(hosts,Opts,[]), {LogType,Hosts}. -pre_init_per_testcase(TestCase,Config,CthState) -> +pre_init_per_testcase(_Suite,TestCase,Config,CthState) -> Logs = lists:map( fun({ConnMod,{LogType,Hosts}}) -> @@ -158,7 +158,7 @@ pre_init_per_testcase(TestCase,Config,CthState) -> ct_util:update_testdata(?MODULE, Update, [create]), {Config,CthState}. -post_end_per_testcase(TestCase,_Config,Return,CthState) -> +post_end_per_testcase(_Suite,TestCase,_Config,Return,CthState) -> Update = fun(PrevUsers) -> case lists:delete(TestCase, PrevUsers) of diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 6d77d7ee9e..eda090d4f5 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -28,10 +28,10 @@ %% CTH Callbacks -export([id/1, init/2, pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4, - pre_init_per_group/3, post_init_per_group/4, - pre_end_per_group/3, post_end_per_group/4, - pre_init_per_testcase/3, post_init_per_testcase/4, - pre_end_per_testcase/3, post_end_per_testcase/4]). + pre_init_per_group/4, post_init_per_group/5, + pre_end_per_group/4, post_end_per_group/5, + pre_init_per_testcase/4, post_init_per_testcase/5, + pre_end_per_testcase/4, post_end_per_testcase/5]). %% Event handler Callbacks -export([init/1, @@ -71,11 +71,11 @@ post_end_per_suite(_Suite, Config, Return, State) -> set_curr_func(undefined, Config), {Return, State}. -pre_init_per_group(Group, Config, State) -> +pre_init_per_group(_Suite, Group, Config, State) -> set_curr_func({group,Group,init_per_group}, Config), {Config, State}. -post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) -> +post_init_per_group(_Suite, Group, Config, Result, tc_log_async) when is_list(Config) -> case lists:member(parallel,proplists:get_value( tc_group_properties,Config,[])) of true -> @@ -83,33 +83,33 @@ post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) -> false -> {Result, tc_log_async} end; -post_init_per_group(_Group, _Config, Result, State) -> +post_init_per_group(_Suite, _Group, _Config, Result, State) -> {Result, State}. -pre_init_per_testcase(TC, Config, State) -> +pre_init_per_testcase(_Suite, TC, Config, State) -> set_curr_func(TC, Config), {Config, State}. -post_init_per_testcase(_TC, _Config, Return, State) -> +post_init_per_testcase(_Suite, _TC, _Config, Return, State) -> {Return, State}. -pre_end_per_testcase(_TC, Config, State) -> +pre_end_per_testcase(_Suite, _TC, Config, State) -> {Config, State}. -post_end_per_testcase(_TC, _Config, Result, State) -> +post_end_per_testcase(_Suite, _TC, _Config, Result, State) -> %% Make sure that the event queue is flushed %% before ending this test case. gen_event:call(error_logger, ?MODULE, flush, 300000), {Result, State}. -pre_end_per_group(Group, Config, {tc_log, Group}) -> +pre_end_per_group(_Suite, Group, Config, {tc_log, Group}) -> set_curr_func({group,Group,end_per_group}, Config), {Config, set_log_func(tc_log_async)}; -pre_end_per_group(Group, Config, State) -> +pre_end_per_group(_Suite, Group, Config, State) -> set_curr_func({group,Group,end_per_group}, Config), {Config, State}. -post_end_per_group(_Group, Config, Return, State) -> +post_end_per_group(_Suite, _Group, Config, Return, State) -> set_curr_func({group,undefined}, Config), {Return, State}. diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 59b916851e..c4941948cc 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -33,16 +33,16 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). --export([pre_init_per_group/3]). --export([post_init_per_group/4]). --export([pre_end_per_group/3]). --export([post_end_per_group/4]). +-export([pre_init_per_group/4]). +-export([post_init_per_group/5]). +-export([pre_end_per_group/4]). +-export([post_end_per_group/5]). --export([pre_init_per_testcase/3]). --export([post_end_per_testcase/4]). +-export([pre_init_per_testcase/4]). +-export([post_end_per_testcase/5]). --export([on_tc_fail/3]). --export([on_tc_skip/3]). +-export([on_tc_fail/4]). +-export([on_tc_skip/4]). -export([terminate/1]). @@ -116,29 +116,29 @@ pre_end_per_suite(_Suite,Config,State) -> post_end_per_suite(_Suite,Config,Result,State) -> {Result, end_tc(end_per_suite,Config,Result,State)}. -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(_Suite,Group,Config,State) -> {Config, init_tc(State#state{ curr_group = [Group|State#state.curr_group]}, Config)}. -post_init_per_group(_Group,Config,Result,State) -> +post_init_per_group(_Suite,_Group,Config,Result,State) -> {Result, end_tc(init_per_group,Config,Result,State)}. -pre_end_per_group(_Group,Config,State) -> +pre_end_per_group(_Suite,_Group,Config,State) -> {Config, init_tc(State, Config)}. -post_end_per_group(_Group,Config,Result,State) -> +post_end_per_group(_Suite,_Group,Config,Result,State) -> NewState = end_tc(end_per_group, Config, Result, State), {Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}. -pre_init_per_testcase(_TC,Config,State) -> +pre_init_per_testcase(_Suite,_TC,Config,State) -> {Config, init_tc(State, Config)}. -post_end_per_testcase(TC,Config,Result,State) -> +post_end_per_testcase(_Suite,TC,Config,Result,State) -> {Result, end_tc(TC,Config, Result,State)}. -on_tc_fail(_TC, _Res, State = #state{test_cases = []}) -> +on_tc_fail(_Suite,_TC, _Res, State = #state{test_cases = []}) -> State; -on_tc_fail(_TC, Res, State) -> +on_tc_fail(_Suite,_TC, Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ @@ -146,10 +146,9 @@ on_tc_fail(_TC, Res, State) -> {fail,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. -on_tc_skip({ConfigFunc,_GrName},{Type,_Reason} = Res, State0) - when Type == tc_auto_skip; Type == tc_user_skip -> - on_tc_skip(ConfigFunc, Res, State0); -on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> +on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) -> + on_tc_skip(Suite,ConfigFunc, Res, State); +on_tc_skip(Suite,Tc, Res, State0) -> TcStr = atom_to_list(Tc), State = case State0#state.test_cases of @@ -158,11 +157,7 @@ on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> _ -> State0 end, - do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[]))); -on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) -> - State; -on_tc_skip(_Tc, Res, State) -> - do_tc_skip(Res, State). + do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(set_suite(Suite,State),[]))). do_tc_skip(Res, State) -> TCs = State#state.test_cases, @@ -209,6 +204,12 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, result = passed }| State#state.test_cases], tc_log = ""}. % so old tc_log is not set if next is on_tc_skip + +set_suite(Suite,#state{curr_suite=undefined}=State) -> + State#state{curr_suite=Suite, curr_suite_ts=?now}; +set_suite(_,State) -> + State. + close_suite(#state{ test_cases = [] } = State) -> State; close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> @@ -228,7 +229,8 @@ close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> testcases = lists:reverse(TCs), log = SuiteLog, url = SuiteUrl}, - State#state{ test_cases = [], + State#state{ curr_suite = undefined, + test_cases = [], test_suites = [Suite | State#state.test_suites]}. terminate(State = #state{ test_cases = [] }) -> diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 924086f2bd..be49191f2e 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -778,9 +778,9 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid, %% if init_per_testcase fails, the test case %% should be skipped try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[CurrConf]}, Why), - do_init_tc_call(Mod,{end_per_testcase,Func}, + do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, [CurrConf],{ok,[CurrConf]}), - do_end_tc_call(Mod,{end_per_testcase,Func}, + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, {Pid,Skip,[CurrConf]}, Why) end of _ -> ok catch @@ -1151,14 +1151,14 @@ do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) -> Args end, EPTCInitRes = - case do_init_tc_call(Mod,{end_per_testcase,Func}, + case do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, IPTCEndRes,Return) of {ok,EPTCInitConfig} when is_list(EPTCInitConfig) -> {Return,EPTCInitConfig}; _ -> - Return + {Return,IPTCEndRes} end, - do_end_tc_call1(Mod, {end_per_testcase,Func}, + do_end_tc_call1(Mod, {end_per_testcase_not_run,Func}, EPTCInitRes, Return); _Ok -> do_end_tc_call1(Mod, IPTC, Res, Return) diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index b52e4bef9b..39c523f8b3 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -2051,17 +2051,21 @@ add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) -> add_init_and_end_per_suite([], LastMod, LastRef, FwMod) -> %% we'll add end_per_suite here even if it's not exported %% (and simply let the call fail if it's missing) - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - [{conf,LastRef,[],{LastMod,end_per_suite}}]; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> %% let's call a "fake" end_per_suite if it exists case erlang:function_exported(FwMod, end_per_suite, 1) of true -> [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}] - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + [{conf,LastRef,[],{LastMod,end_per_suite}}] end. do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> @@ -2070,11 +2074,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> _ -> ok end, {Init,NextMod,NextRef} = - case erlang:function_exported(Mod, init_per_suite, 1) of - true -> - Ref = make_ref(), - {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref}; - false -> + case {erlang:function_exported(Mod, init_per_suite, 1), + erlang:function_exported(Mod, end_per_suite, 1)} of + {false,false} -> %% let's call a "fake" init_per_suite if it exists case erlang:function_exported(FwMod, init_per_suite, 1) of true -> @@ -2083,8 +2085,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> {FwMod,init_per_suite}}],Mod,Ref}; false -> {[],Mod,undefined} - end - + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + Ref = make_ref(), + {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref} end, Cases = if LastRef==undefined -> @@ -2094,10 +2101,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> true -> %% we'll add end_per_suite here even if it's not exported %% (and simply let the call fail if it's missing) - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> %% let's call a "fake" end_per_suite if it exists case erlang:function_exported(FwMod, end_per_suite, 1) of true -> @@ -2105,8 +2111,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> {FwMod,end_per_suite}}|Init]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] - end - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] + end end, {Cases,NextMod,NextRef}. @@ -2115,11 +2126,9 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> No when No==undefined ; No==skipped_suite -> {[],Mod,skipped_suite}; _Ref -> - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - {[{conf,LastRef,[],{LastMod,end_per_suite}}], - Mod,skipped_suite}; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> case erlang:function_exported(FwMod, end_per_suite, 1) of true -> %% let's call "fake" end_per_suite if it exists @@ -2128,7 +2137,13 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> false -> {[{conf,LastRef,[],{LastMod,end_per_suite}}], Mod,skipped_suite} - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + {[{conf,LastRef,[],{LastMod,end_per_suite}}], + Mod,skipped_suite} end end. @@ -2924,22 +2939,21 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) exit(framework_error); %% sequential execution of test case finished {Time,RetVal,_} -> + RetTag = + if is_tuple(RetVal) -> element(1,RetVal); + true -> undefined + end, {Failed,Status1} = - case Time of - died -> - {true,update_status(failed, Mod, Func, Status)}; - _ when is_tuple(RetVal) -> - case element(1, RetVal) of - R when R=='EXIT'; R==failed -> - {true,update_status(failed, Mod, Func, Status)}; - R when R==skip; R==skipped -> - {false,update_status(skipped, Mod, Func, Status)}; - _ -> - {false,update_status(ok, Mod, Func, Status)} - end; - _ -> - {false,update_status(ok, Mod, Func, Status)} - end, + case RetTag of + Skip when Skip==skip; Skip==skipped -> + {false,update_status(skipped, Mod, Func, Status)}; + Fail when Fail=='EXIT'; Fail==failed -> + {true,update_status(failed, Mod, Func, Status)}; + _ when Time==died, RetVal=/=ok -> + {true,update_status(failed, Mod, Func, Status)}; + _ -> + {false,update_status(ok, Mod, Func, Status)} + end, case check_prop(sequence, Mode) of false -> stop_minor_log_file(), @@ -3794,7 +3808,15 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, {died,{timetrap_timeout,TimetrapTimeout}} -> progress(failed, Num, Mod, Func, GrName, Loc, timetrap_timeout, TimetrapTimeout, Comment, Style); - {died,Reason} -> + {died,{Skip,Reason}} when Skip==skip; Skip==skipped -> + %% died in init_per_testcase + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {died,Reason} when Reason=/=ok -> + %% (If Reason==ok it means that process died in + %% end_per_testcase after successfully completing the + %% test case itself - then we shall not fail, but a + %% warning will be issued in the comment field.) progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped; @@ -3943,6 +3965,9 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {ReportTag,Reason1}}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), ReasonStr = escape_chars(reason_to_string(Reason1)), ReasonStr1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ReasonStr,[$\n])]), @@ -3957,10 +3982,10 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, _ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")" end, print(html, - "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>" "<td><font color=\"~ts\">SKIPPED</font></td>" "<td>~ts~ts</td></tr>\n", - [Time,Color,ReasonStr2,Comment1]), + [TimeStr,Color,ReasonStr2,Comment1]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== Location: ~ts", [FormatLoc]), print(minor, "=== Reason: ~ts", [ReasonStr1]), @@ -4098,6 +4123,9 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, Comment0, {St0,St1}) -> print(minor, "successfully completed test case", []), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), Comment = case RetVal of {comment,RetComment} -> @@ -4116,10 +4144,10 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, end, print(major, "=elapsed ~p", [Time]), print(html, - "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>" "<td><font color=\"green\">Ok</font></td>" "~ts</tr>\n", - [Time,Comment]), + [TimeStr,Comment]), print(minor, escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])), []), diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index b1eddfedd7..2f0fc2e05a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -70,7 +70,8 @@ MODULES= \ test_server_SUITE \ test_server_test_lib \ ct_release_test_SUITE \ - ct_log_SUITE + ct_log_SUITE \ + ct_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl new file mode 100644 index 0000000000..eb98c2544f --- /dev/null +++ b/lib/common_test/test/ct_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-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_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{timetrap,{seconds,30}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [app_file, appup_file]. + +%%%----------------------------------------------------------------- +%%% Test cases + +app_file(_Config) -> + ok = test_server:app_test(common_test), + ok. + +appup_file(_Config) -> + ok = test_server:appup_test(common_test). + diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index fae23484e6..621f3b6d2d 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -1531,17 +1531,17 @@ test_events(config_func_errors) -> {?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}}, - {?eh,test_stats,{0,1,{0,0}}}, + {?eh,test_stats,{0,0,{0,1}}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}}, - {?eh,test_stats,{0,2,{0,0}}}, + {?eh,test_stats,{1,0,{0,1}}}, [{?eh,tc_start,{config_func_error_1_SUITE,{init_per_group,g1,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g1,[]},ok}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}}, - {?eh,test_stats,{0,3,{0,0}}}, + {?eh,test_stats,{1,0,{0,2}}}, {?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g1,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g1,[]},ok}}], @@ -1549,7 +1549,7 @@ test_events(config_func_errors) -> {?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g2,[]},ok}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}}, - {?eh,test_stats,{0,4,{0,0}}}, + {?eh,test_stats,{2,0,{0,2}}}, {?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g2,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g2,[]},ok}}], diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 690d0af1bb..93bcb8fe52 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -70,22 +70,25 @@ suite() -> all() -> all(suite). -all(suite) -> +all(suite) -> lists:reverse( [ 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, + 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_per_suite_state_cth, scope_per_group_state_cth, + scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, + skip_pre_init_tc_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, - state_update_cth, options_cth, same_id_cth, + state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, - data_dir, cth_log + no_init_suite_config, no_init_config, no_end_config, + failed_sequence, repeat_force_stop, config_clash, + callbacks_on_skip, fallback, data_dir, cth_log ] ). @@ -96,10 +99,10 @@ all(suite) -> %%%----------------------------------------------------------------- %%% -one_cth(Config) when is_list(Config) -> +one_cth(Config) when is_list(Config) -> do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config). -two_cth(Config) when is_list(Config) -> +two_cth(Config) when is_list(Config) -> do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth], Config). @@ -119,13 +122,13 @@ minimal_cth(Config) when is_list(Config) -> minimal_and_maximal_cth(Config) when is_list(Config) -> do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl", [minimal_cth, empty_cth],Config). - + faulty_cth_undef(Config) when is_list(Config) -> do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl", [undef_cth],Config). faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) -> - do_test(faulty_cth_exit_in_init_scope_suite, + do_test(faulty_cth_exit_in_init_scope_suite, "ct_exit_in_init_scope_suite_cth_SUITE.erl", [],Config). @@ -190,6 +193,10 @@ skip_post_suite_cth(Config) when is_list(Config) -> do_test(skip_post_suite_cth, "ct_cth_empty_SUITE.erl", [skip_post_suite_cth],Config). +skip_pre_init_tc_cth(Config) -> + do_test(skip_pre_init_tc_cth, "ct_cth_empty_SUITE.erl", + [skip_pre_init_tc_cth],Config). + recover_post_suite_cth(Config) when is_list(Config) -> do_test(recover_post_suite_cth, "ct_cth_fail_per_suite_SUITE.erl", [recover_post_suite_cth],Config). @@ -205,7 +212,7 @@ state_update_cth(Config) when is_list(Config) -> options_cth(Config) when is_list(Config) -> do_test(options_cth, "ct_cth_empty_SUITE.erl", [{empty_cth,[test]}],Config). - + same_id_cth(Config) when is_list(Config) -> do_test(same_id_cth, "ct_cth_empty_SUITE.erl", [same_id_cth,same_id_cth],Config). @@ -223,13 +230,24 @@ no_config(Config) when is_list(Config) -> do_test(no_config, "ct_no_config_SUITE.erl", [verify_config_cth],Config). +no_init_suite_config(Config) when is_list(Config) -> + do_test(no_init_suite_config, "ct_no_init_suite_config_SUITE.erl", + [empty_cth],Config). + +no_init_config(Config) when is_list(Config) -> + do_test(no_init_config, "ct_no_init_config_SUITE.erl",[empty_cth],Config). + +no_end_config(Config) when is_list(Config) -> + do_test(no_end_config, "ct_no_end_config_SUITE.erl",[empty_cth],Config). + data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). -cth_log(Config) when is_list(Config) -> +cth_log(Config) when is_list(Config) -> %% test that cth_log_redirect writes properly to %% unexpected I/O log + ct:timetrap({minutes,10}), StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), Logdir = proplists:get_value(logdir, StartOpts), UnexpIoLogs = @@ -253,29 +271,57 @@ cth_log(Config) when is_list(Config) -> end, UnexpIoLogs), ok. +%% OTP-10599 adds the Suite argument as first argument to all hook +%% callbacks that did not have a Suite argument from before. This test +%% checks that ct_hooks will fall back to old versions of callbacks if +%% new versions are not exported. +fallback(Config) -> + do_test(fallback, "all_hook_callbacks_SUITE.erl",[fallback_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped in different ways +callbacks_on_skip(Config) -> + do_test(callbacks_on_skip, {spec,"skip.spec"},[skip_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped due to failed sequence +failed_sequence(Config) -> + do_test(failed_sequence, "seq_SUITE.erl", [skip_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped due to {force_stop,skip_rest} option +repeat_force_stop(Config) -> + do_test(repeat_force_stop, "repeat_SUITE.erl", [skip_cth], Config, ok, 2, + [{force_stop,skip_rest},{duration,"000009"}]). + +%% Test that expected callbacks, and only those, are called when a test +%% are fails due to clash in config alias names +config_clash(Config) -> + do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config). %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- -do_test(Tag, SWC, CTHs, Config) -> - do_test(Tag, SWC, CTHs, Config, ok). -do_test(Tag, SWC, CTHs, Config, {error,_} = Res) -> - do_test(Tag, SWC, CTHs, Config, Res, 1); -do_test(Tag, SWC, CTHs, Config, Res) -> - do_test(Tag, SWC, CTHs, Config, Res, 2). +do_test(Tag, WTT, CTHs, Config) -> + do_test(Tag, WTT, CTHs, Config, ok). +do_test(Tag, WTT, CTHs, Config, {error,_} = Res) -> + do_test(Tag, WTT, CTHs, Config, Res, 1,[]); +do_test(Tag, WTT, CTHs, Config, Res) -> + do_test(Tag, WTT, CTHs, Config, Res, 2,[]). -do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> - +do_test(Tag, WhatToTest, CTHs, Config, Res, EC, ExtraOpts) when is_list(WhatToTest) -> + do_test(Tag, {suite,WhatToTest}, CTHs, Config, Res, EC, ExtraOpts); +do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) -> DataDir = ?config(data_dir, Config), - Suites = filelib:wildcard( - filename:join([DataDir,"cth/tests",SuiteWildCard])), - {Opts,ERPid} = setup([{suite,Suites}, - {ct_hooks,CTHs},{label,Tag}], Config), + Files = filelib:wildcard( + filename:join([DataDir,"cth/tests",Wildcard])), + {Opts,ERPid} = + setup([{WhatTag,Files},{ct_hooks,CTHs},{label,Tag}|ExtraOpts], Config), Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Tag, + ct_test_support:log_events(Tag, reformat(Events, ?eh), ?config(priv_dir, Config), Opts), @@ -323,12 +369,12 @@ test_events(one_empty_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{empty_cth,post_init_per_testcase,[test_case,'$proplist','_',[]]}}, - {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -355,12 +401,12 @@ test_events(two_empty_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -402,7 +448,7 @@ test_events(minimal_cth) -> {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -423,10 +469,10 @@ test_events(minimal_and_maximal_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}}, @@ -452,11 +498,11 @@ test_events(faulty_cth_undef) -> {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -512,10 +558,10 @@ test_events(scope_per_suite_cth) -> {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_cth_SUITE,'$proplist',[]]}}, @@ -538,10 +584,10 @@ test_events(scope_suite_cth) -> {?eh,tc_done,{ct_scope_suite_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_suite_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}}, @@ -561,20 +607,20 @@ test_events(scope_per_group_cth) -> [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1, '$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -592,10 +638,10 @@ test_events(scope_per_suite_state_cth) -> {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}}, @@ -618,10 +664,10 @@ test_events(scope_suite_state_cth) -> {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}}, @@ -641,20 +687,20 @@ test_events(scope_per_group_state_cth) -> [{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[test]]}}, {?eh,cth,{'_',init,['_',[test]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','$proplist',[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','_',[test]]}}, {?eh,cth,{'_',terminate,[[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -666,7 +712,7 @@ test_events(fail_pre_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist', @@ -674,27 +720,27 @@ test_events(fail_pre_suite_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed, {error,"Test failure"}}}}, {?eh,cth,{'_',on_tc_fail, - [init_per_suite,{failed,"Test failure"},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,"Test failure",[]]}}, + - {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip, - [test_case, {tc_auto_skip, + [ct_cth_empty_SUITE,test_case, {tc_auto_skip, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip, - [end_per_suite, {tc_auto_skip, + [ct_cth_empty_SUITE,end_per_suite, {tc_auto_skip, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -727,17 +773,17 @@ test_events(fail_post_suite_cth) -> {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed,{error,"Test failure"}}}}, - {?eh,cth,{'_',on_tc_fail,[init_per_suite, {failed,"Test failure"}, []]}}, + {?eh,cth,{'_',on_tc_fail,[ct_cth_empty_SUITE,init_per_suite, "Test failure", []]}}, {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}}, - + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_auto_skip,'_'},[]]}}, + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, - {?eh,cth,{'_',on_tc_skip,[end_per_suite,{tc_auto_skip,'_'},[]]}}, + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,end_per_suite,{tc_auto_skip,'_'},[]]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, @@ -754,11 +800,11 @@ test_events(skip_pre_suite_cth) -> {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}}, {?eh,cth,{'_',on_tc_skip, - [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}}, + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -772,31 +818,33 @@ test_events(skip_pre_end_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}, {skipped,"Test skip"}}}], - {?eh,cth,{'_',on_tc_skip,[{end_per_group,group1}, - {tc_user_skip,{skipped,"Test skip"}}, + {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE, + {end_per_group,group1}, + {tc_user_skip,"Test skip"}, []]}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite, {skipped,"Test skip"}}}, - {?eh,cth,{'_',on_tc_skip,[end_per_suite, - {tc_user_skip,{skipped,"Test skip"}}, + {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE, + end_per_suite, + {tc_user_skip,"Test skip"}, []]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, @@ -808,24 +856,59 @@ test_events(skip_post_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}}, {?eh,cth,{'_',on_tc_skip, - [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}}, + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,stop_logging,[]} ]; +test_events(skip_pre_init_tc_cth) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [ct_cth_empty_SUITE,test_case,'$proplist', + {skip,"Skipped in pre_init_per_testcase"}, + []]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,test_case, + {skipped,"Skipped in pre_init_per_testcase"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_cth_empty_SUITE,test_case, + {tc_user_skip,"Skipped in pre_init_per_testcase"}, + []]}}, + {?eh,test_stats,{0,0,{1,0}}}, + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_cth_empty_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(recover_post_suite_cth) -> Suite = ct_cth_fail_per_suite_SUITE, [ @@ -840,11 +923,11 @@ test_events(recover_post_suite_cth) -> {?eh,tc_start,{Suite,test_case}}, {?eh,cth,{'_',pre_init_per_testcase, - [test_case, not_contains([tc_status]),[]]}}, + [Suite,test_case, not_contains([tc_status]),[]]}}, {?eh,cth,{'_',post_end_per_testcase, - [test_case, contains([tc_status]),'_',[]]}}, + [Suite,test_case, contains([tc_status]),'_',[]]}}, {?eh,tc_done,{Suite,test_case,ok}}, - + {?eh,tc_start,{Suite,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [Suite,not_contains([tc_status]),[]]}}, @@ -861,7 +944,7 @@ test_events(update_config_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, [ct_update_config_SUITE,contains([]),[]]}}, @@ -876,13 +959,15 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE, {init_per_group,group1,[]}}}, {?eh,cth,{'_',pre_init_per_group, - [group1,contains( + [ct_update_config_SUITE, + group1,contains( [post_init_per_suite, init_per_suite, pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_init_per_group, - [group1, + [ct_update_config_SUITE, + group1, contains( [post_init_per_suite, init_per_suite, @@ -898,7 +983,8 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase, - [test_case,contains( + [ct_update_config_SUITE, + test_case,contains( [post_init_per_group, init_per_group, pre_init_per_group, @@ -907,7 +993,8 @@ test_events(update_config_cth) -> pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_end_per_testcase, - [test_case,contains( + [ct_update_config_SUITE, + test_case,contains( [init_per_testcase, pre_init_per_testcase, post_init_per_group, @@ -921,7 +1008,8 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE, {end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group, - [group1,contains( + [ct_update_config_SUITE, + group1,contains( [post_init_per_group, init_per_group, pre_init_per_group, @@ -930,7 +1018,8 @@ test_events(update_config_cth) -> pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_end_per_group, - [group1, + [ct_update_config_SUITE, + group1, contains( [pre_end_per_group, post_init_per_group, @@ -941,7 +1030,7 @@ test_events(update_config_cth) -> pre_init_per_suite]), ok,[]]}}, {?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_update_config_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_update_config_SUITE,contains( @@ -974,7 +1063,7 @@ test_events(state_update_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, - + {?eh,tc_done,{'_',end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[contains( @@ -1018,10 +1107,10 @@ test_events(options_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}}, + {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[test]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -1051,14 +1140,14 @@ test_events(same_id_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, {negative, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}}, {negative, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -1094,11 +1183,13 @@ test_events(fail_n_skip_with_minimal_cth) -> {?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case2,{skipped,"skip it"}}}, {?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,test_case3}}, {?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case3,{skipped,"skip it"}}}, - {?eh,cth,{empty_cth,on_tc_skip,[{test_case2,group2}, - {tc_user_skip,{skipped,"skip it"}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE, + {test_case2,group2}, + {tc_user_skip,"skip it"}, []]}}, - {?eh,cth,{empty_cth,on_tc_skip,[{test_case3,group2}, - {tc_user_skip,{skipped,"skip it"}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE, + {test_case3,group2}, + {tc_user_skip,"skip it"}, []]}}, {?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,{end_per_group, group2,[parallel]}}}, @@ -1115,17 +1206,25 @@ test_events(fail_n_skip_with_minimal_cth) -> ]; test_events(prio_cth) -> - - GenPre = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_',State]}} || + GenPre = fun(Func,States) when Func==pre_init_per_suite; + Func==pre_end_per_suite -> + [{?eh,cth,{'_',Func,['_','_',State]}} || + State <- States]; + (Func,States) -> + [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States] end, - GenPost = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_','_',State]}} || + GenPost = fun(Func,States) when Func==post_init_per_suite; + Func==post_end_per_suite -> + [{?eh,cth,{'_',Func,['_','_','_',State]}} || + State <- States]; + (Func,States) -> + [{?eh,cth,{'_',Func,['_','_','_','_',State]}} || State <- States] - end, - + + end, + [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ @@ -1136,7 +1235,7 @@ test_events(prio_cth) -> [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], [1200,1050],[1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++ GenPre(pre_init_per_group, @@ -1147,7 +1246,7 @@ test_events(prio_cth) -> [900],[900,900],[500,900],[1000],[1200,1050], [1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++ - + [{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++ GenPre(pre_init_per_testcase, [[1100,100],[600,200],[600,600],[600],[700],[800], @@ -1161,7 +1260,7 @@ test_events(prio_cth) -> [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ - GenPre(pre_end_per_group, + GenPre(pre_end_per_group, lists:reverse( [[1100,100],[600,200],[600,600],[600],[700],[800], [900],[900,900],[500,900],[1000],[1200,1050], @@ -1200,30 +1299,30 @@ test_events(no_config) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ct_no_config_SUITE,test_case_1}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_1,'$proplist',[]]}}, + [ct_no_config_SUITE,test_case_1,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_1,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_case_1,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_no_config_SUITE,test_case_1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_init_per_group, - [test_group,'$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_init_per_group, - [test_group,'$proplist','$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_framework, {init_per_group,test_group,'$proplist'},ok}}, {?eh,tc_start,{ct_no_config_SUITE,test_case_2}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_2,'$proplist',[]]}}, + [ct_no_config_SUITE,test_case_2,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_2,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_case_2,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_no_config_SUITE,test_case_2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_end_per_group, - [test_group,'$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_group, - [test_group,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, @@ -1236,6 +1335,166 @@ test_events(no_config) -> {?eh,stop_logging,[]} ]; +test_events(no_init_suite_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_no_init_suite_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_init_suite_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_init_suite_config_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_init_suite_config_SUITE,init_per_suite, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_suite_config_SUITE, + init_per_suite, + {undef,'_'},[]]}}, + {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,test_case, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_no_init_suite_config_SUITE, + test_case, + {tc_auto_skip, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_stats,{0,0,{0,1}}}, + {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,end_per_suite, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_no_init_suite_config_SUITE, + end_per_suite, + {tc_auto_skip, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(no_init_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_no_init_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_init_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_init_config_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_no_init_config_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_init_config_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_init_config_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + [{?eh,tc_start,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [ct_no_init_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [ct_no_init_config_SUITE,test_group,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_config_SUITE, + {init_per_group,test_group}, + {undef,'_'},[]]}}, + {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{test_case_2,test_group}, + {failed,{ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE, + {test_case_2,test_group}, + {tc_auto_skip, + {failed, + {ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_stats,{1,0,{0,1}}}, + {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{end_per_group,test_group}, + {failed,{ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE, + {end_per_group,test_group}, + {tc_auto_skip, + {failed, + {ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}, + []]}}], + {?eh,tc_start,{ct_no_init_config_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [ct_no_init_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_no_init_config_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(no_end_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_no_end_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_end_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_end_config_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_no_end_config_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_end_config_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_end_config_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + [{?eh,tc_start,{ct_no_end_config_SUITE, + {init_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE, + {init_per_group,test_group,'$proplist'},ok}}, + {?eh,tc_start,{ct_no_end_config_SUITE,test_case_2}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_end_config_SUITE,test_case_2,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_end_config_SUITE,test_case_2,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,test_case_2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_start,{ct_no_end_config_SUITE, + {end_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_end_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,{end_per_group,test_group,[]}, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_end_config_SUITE, + {end_per_group,test_group}, + {undef,'_'},[]]}}], + {?eh,tc_start,{ct_no_end_config_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [ct_no_end_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_no_end_config_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,end_per_suite, + {failed,{error,{undef,'_'}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(data_dir) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, @@ -1250,30 +1509,30 @@ test_events(data_dir) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ct_data_dir_SUITE,test_case_1}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_data_dir_SUITE,test_case_1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_init_per_group, - [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_init_per_group, - [test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_framework, {init_per_group,test_group,'$proplist'},ok}}, {?eh,tc_start,{ct_data_dir_SUITE,test_case_2}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_data_dir_SUITE,test_case_2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_end_per_group, - [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_group, - [test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, @@ -1300,16 +1559,654 @@ test_events(cth_log) -> [{suite,cth_log_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{end_per_group,g1, [{suite,cth_log_SUITE},parallel]},ok}}]}, - + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; +test_events(fallback) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [all_hook_callbacks_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [all_hook_callbacks_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,init_per_suite,ok}}, + + [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [fallback_nosuite,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [fallback_nosuite,test_group,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework, + {init_per_group,test_group,'$proplist'},ok}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [fallback_nosuite,test_case,'$proplist',ok,[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_end_per_group, + [fallback_nosuite,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_group, + [fallback_nosuite,test_group,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], + {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [fallback_nosuite,test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [fallback_nosuite,test_case,'$proplist','_',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,skip_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,skip_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [fallback_nosuite,skip_case,'$proplist', + {skip,"Skipped in init_per_testcase/2"},[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,skip_case, + {skipped,"Skipped in init_per_testcase/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [fallback_nosuite,skip_case, + {tc_user_skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,test_stats,{2,0,{1,0}}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [all_hook_callbacks_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [all_hook_callbacks_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(callbacks_on_skip) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{6,6,15}}, + + %% all_hook_callbacks_SUITE is skipped in spec + %% Only the on_tc_skip callback shall be called + {?eh,tc_user_skip,{all_hook_callbacks_SUITE,all,"Skipped in spec"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [all_hook_callbacks_SUITE,all, + {tc_user_skip,"Skipped in spec"}, + []]}}, + {?eh,test_stats,{0,0,{1,0}}}, + + %% skip_init_SUITE is skipped in its init_per_suite function + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_init_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_init_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_init_SUITE, + '$proplist', + {skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,tc_done,{skip_init_SUITE,init_per_suite, + {skipped,"Skipped in init_per_suite/1"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,init_per_suite, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,tc_user_skip,{skip_init_SUITE,test_case,"Skipped in init_per_suite/1"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,test_case, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,test_stats,{0,0,{2,0}}}, + {?eh,tc_user_skip,{skip_init_SUITE,end_per_suite, + "Skipped in init_per_suite/1"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,end_per_suite, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + + %% skip_req_SUITE is auto-skipped since a 'require' statement + %% returned by suite/0 is not fulfilled. + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_req_SUITE,init_per_suite}}, + {?eh,tc_done,{skip_req_SUITE,init_per_suite, + {auto_skipped,{require_failed_in_suite0, + {not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,init_per_suite, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + {?eh,tc_auto_skip,{skip_req_SUITE,test_case,{require_failed_in_suite0, + {not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,test_case, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + {?eh,test_stats,{0,0,{2,1}}}, + {?eh,tc_auto_skip,{skip_req_SUITE,end_per_suite, + {require_failed_in_suite0, + {not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,end_per_suite, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + + %% skip_fail_SUITE is auto-skipped since the suite/0 function + %% retuns a faluty format. + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_fail_SUITE,init_per_suite}}, + {?eh,tc_done,{skip_fail_SUITE,init_per_suite, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,init_per_suite, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + {?eh,tc_auto_skip,{skip_fail_SUITE,test_case, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,test_case, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + {?eh,test_stats,{0,0,{2,2}}}, + {?eh,tc_auto_skip,{skip_fail_SUITE,end_per_suite, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,end_per_suite, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + + %% skip_group_SUITE + {?eh,tc_start,{skip_group_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_group_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_group_SUITE, + '$proplist', + '_', + []]}}, + {?eh,tc_done,{skip_group_SUITE,init_per_suite,ok}}, + + %% test_group_1 - auto_skip due to require failed + [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_1,[]}}}, + {?eh,tc_done, + {skip_group_SUITE,{init_per_group,test_group_1,[]}, + {auto_skipped,{require_failed,{not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_1}, + {require_failed,{not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,test_stats,{0,0,{2,3}}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_1}, + {require_failed,{not_available,whatever}}}}], + %% The following appears to be outside of the group, but + %% that's only an implementation detail in + %% ct_test_support.erl - it does not know about events from + %% test suite specific hooks and regards the group ended with + %% the above tc_auto_skip-event for end_per_group. + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + + %% test_group_2 - auto_skip due to failed return from group/1 + [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_2,[]}}}, + {?eh,tc_done, + {skip_group_SUITE,{init_per_group,test_group_2,[]}, + {auto_skipped,{group0_failed,bad_return_value}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_2}, + {group0_failed,bad_return_value}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + {?eh,test_stats,{0,0,{2,4}}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_2}, + {group0_failed,bad_return_value}}}], + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + %% test_group_3 - user_skip in init_per_group/2 + [{?eh,tc_start, + {skip_group_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [skip_group_SUITE,test_group_3,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [skip_group_SUITE,test_group_3,'$proplist', + {skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,tc_done,{skip_group_SUITE, + {init_per_group,test_group_3,[]}, + {skipped,"Skipped in init_per_group/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,tc_user_skip,{skip_group_SUITE, + {test_case,test_group_3}, + "Skipped in init_per_group/2"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,test_stats,{0,0,{3,4}}}, + {?eh,tc_user_skip,{skip_group_SUITE, + {end_per_group,test_group_3}, + "Skipped in init_per_group/2"}}], + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + + {?eh,tc_start,{skip_group_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [skip_group_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [skip_group_SUITE, + '$proplist', + ok,[]]}}, + {?eh,tc_done,{skip_group_SUITE,end_per_suite,ok}}, + + + %% skip_case_SUITE has 4 test cases which are all skipped in + %% different ways + {?eh,tc_start,{skip_case_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_case_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_case_SUITE, + '$proplist', + '_', + []]}}, + {?eh,tc_done,{skip_case_SUITE,init_per_suite,ok}}, + + %% Skip in spec -> only on_tc_skip shall be called + {?eh,tc_user_skip,{skip_case_SUITE,skip_in_spec,"Skipped in spec"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_spec, + {tc_user_skip,"Skipped in spec"}, + []]}}, + {?eh,test_stats,{0,0,{4,4}}}, + + %% Skip in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,skip_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,skip_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,skip_in_init, + '$proplist', + {skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,skip_in_init, + {skipped,"Skipped in init_per_testcase/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_init, + {tc_user_skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,test_stats,{0,0,{5,4}}}, + + %% Fail in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,fail_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,fail_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,fail_in_init, + '$proplist', + {skip,{failed,'_'}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,fail_in_init, + {auto_skipped,{failed,'_'}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,fail_in_init, + {tc_auto_skip,{failed,'_'}}, + []]}}, + {?eh,test_stats,{0,0,{5,5}}}, + + %% Exit in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,exit_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,exit_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,exit_in_init, + '$proplist', + {skip,{failed,'_'}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,exit_in_init, + {auto_skipped,{failed,'_'}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,exit_in_init, + {tc_auto_skip,{failed,'_'}}, + []]}}, + {?eh,test_stats,{0,0,{5,6}}}, + + %% Fail in end_per_testcase -> all hooks shall be called and + %% test shall succeed. + {?eh,tc_start,{skip_case_SUITE,fail_in_end}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + ok, + []]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT', + {test_case_failed,"Failed in end_per_testcase/2"}}}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,fail_in_end, + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT', + {test_case_failed,"Failed in end_per_testcase/2"}}}}}}, + {?eh,test_stats,{1,0,{5,6}}}, + + %% Exit in end_per_testcase -> all hooks shall be called and + %% test shall succeed. + {?eh,tc_start,{skip_case_SUITE,exit_in_end}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + ok, + []]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT',"Exit in end_per_testcase/2"}}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,exit_in_end, + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT',"Exit in end_per_testcase/2"}}}}}, + {?eh,test_stats,{2,0,{5,6}}}, + + %% Skip in testcase function -> all callbacks shall be called + {?eh,tc_start,{skip_case_SUITE,skip_in_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + {skip,"Skipped in test case function"}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,skip_in_case, + {skipped,"Skipped in test case function"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_case, + {tc_user_skip,"Skipped in test case function"}, + []]}}, + {?eh,test_stats,{2,0,{6,6}}}, + + %% Auto skip due to failed 'require' -> only the on_tc_skip + %% callback shall be called + {?eh,tc_start,{skip_case_SUITE,req_auto_skip}}, + {?eh,tc_done,{skip_case_SUITE,req_auto_skip, + {auto_skipped,{require_failed,{not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,req_auto_skip, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,test_stats,{2,0,{6,7}}}, + + %% Auto skip due to failed testcase/0 function -> only the + %% on_tc_skip callback shall be called + {?eh,tc_start,{skip_case_SUITE,fail_auto_skip}}, + {?eh,tc_done,{skip_case_SUITE,fail_auto_skip, + {auto_skipped,{testcase0_failed,bad_return_value}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,fail_auto_skip, + {tc_auto_skip,{testcase0_failed,bad_return_value}}, + []]}}, + {?eh,test_stats,{2,0,{6,8}}}, + + {?eh,tc_start,{skip_case_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [skip_case_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [skip_case_SUITE, + '$proplist', + ok,[]]}}, + {?eh,tc_done,{skip_case_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(failed_sequence) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[seq_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [seq_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{seq_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [seq_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [seq_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [seq_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [seq_SUITE,test_case_1,'$proplist', + {error,failed_on_purpose},[]]}}, + {?eh,tc_done,{seq_SUITE,test_case_1,{failed,{error,failed_on_purpose}}}}, + {?eh,cth,{empty_cth,on_tc_fail, + [seq_SUITE,test_case_1,failed_on_purpose,[]]}}, + {?eh,test_stats,{0,1,{0,0}}}, + {?eh,tc_start,{seq_SUITE,test_case_2}}, + {?eh,tc_done,{seq_SUITE,test_case_2, + {auto_skipped,{sequence_failed,seq1,test_case_1}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [seq_SUITE,test_case_2, + {tc_auto_skip,{sequence_failed,seq1,test_case_1}}, + []]}}, + {?eh,test_stats,{0,1,{0,1}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[seq_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite,[seq_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(repeat_force_stop) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events= + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[repeat_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [repeat_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{repeat_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{repeat_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{repeat_SUITE,test_case_2}}, + {?eh,tc_done,{repeat_SUITE,test_case_2, + {auto_skipped, + "Repeated test stopped by force_stop option"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [repeat_SUITE,test_case_2, + {tc_auto_skip,"Repeated test stopped by force_stop option"}, + []]}}, + {?eh,test_stats,{1,0,{0,1}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[repeat_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [repeat_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(config_clash) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [config_clash_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [config_clash_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{config_clash_SUITE,test_case_1}}, + {?eh,tc_done,{config_clash_SUITE,test_case_1, + {failed,{error,{config_name_already_in_use,[aa]}}}}}, + {?eh,cth,{empty_cth,on_tc_fail, + [config_clash_SUITE,test_case_1, + {config_name_already_in_use,[aa]}, + []]}}, + {?eh,test_stats,{0,1,{0,0}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [config_clash_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [config_clash_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + test_events(ok) -> ok. - %% test events help functions contains(List) -> fun(Proplist) when is_list(Proplist) -> diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl new file mode 100644 index 0000000000..5b50548694 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(all_hook_callbacks_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +%% Test server callback functions +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(Config) -> + Config. + +end_per_group(_Config) -> + ok. + +init_per_testcase(skip_case, Config) -> + {skip,"Skipped in init_per_testcase/2"}; +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [{group,test_group},test_case,skip_case]. + +groups() -> + [{test_group,[test_case]}]. + +%% Test cases starts here. +test_case(Config) -> + ok. + +skip_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl new file mode 100644 index 0000000000..f74c757cc1 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl @@ -0,0 +1,43 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(config_clash_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + [{require,aa,yy},{default_config,yy,"this is a default value"}]. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case_1]. + +%% Test cases starts here. +test_case_1() -> + [{require,aa,xx}]. +test_case_1(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl new file mode 100644 index 0000000000..7cdaf2024b --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl @@ -0,0 +1,51 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_no_end_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that all pre/post_end_per_* callbacks +%%% are called with correct SuiteName even if no end_per_* config +%%% function exist in the suite, and that the non-exported config +%%% functions fail with 'undef'. + +init_per_suite(Config) -> + Config. + +init_per_group(_Group,Config) -> + Config. + +init_per_testcase(_TC,Config) -> + Config. + +all() -> + [test_case_1, {group,test_group}]. + +groups() -> + [{test_group,[],[test_case_2]}]. + +test_case_1(Config) -> + ok. + +test_case_2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl new file mode 100644 index 0000000000..43c062d66f --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl @@ -0,0 +1,54 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_no_init_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that all +%%% pre/post_init_per_group/testcase callbacks are called with correct +%%% SuiteName even if no init_per_group/testcase function exist in the +%%% suite, and that the non-exported config functions fail with 'undef'. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +end_per_group(_Group,Config) -> + Config. + +end_per_testcase(_TC,Config) -> + Config. + +all() -> + [test_case_1, {group,test_group}]. + +groups() -> + [{test_group,[],[test_case_2]}]. + +test_case_1(Config) -> + ok. + +test_case_2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl new file mode 100644 index 0000000000..85dfe8ca4b --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_no_init_suite_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that pre/post_init_per_suite +%%% callbacks are called with correct SuiteName even if no +%%% init_per_suite function exist in the suite, and that the +%%% non-exported config function fails with 'undef'. + +end_per_suite(Config) -> + Config. + +all() -> + [test_case]. + +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index c00eb5cf93..37742f0d20 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -44,18 +44,18 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). --export([pre_init_per_group/3]). --export([post_init_per_group/4]). --export([pre_end_per_group/3]). --export([post_end_per_group/4]). +-export([pre_init_per_group/4]). +-export([post_init_per_group/5]). +-export([pre_end_per_group/4]). +-export([post_end_per_group/5]). --export([pre_init_per_testcase/3]). --export([post_init_per_testcase/4]). --export([pre_end_per_testcase/3]). --export([post_end_per_testcase/4]). +-export([pre_init_per_testcase/4]). +-export([post_init_per_testcase/5]). +-export([pre_end_per_testcase/4]). +-export([post_end_per_testcase/5]). --export([on_tc_fail/3]). --export([on_tc_skip/3]). +-export([on_tc_fail/4]). +-export([on_tc_skip/4]). -export([terminate/1]). @@ -154,150 +154,160 @@ post_end_per_suite(Suite,Config,Return,State) -> %% @doc Called before each init_per_group. %% You can change the config in this function. --spec pre_init_per_group(Group :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_init_per_group(Suite :: atom(), + Group :: atom(), + Config :: config(), + State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_init_per_group, - [Group,Config,State]}}), - ct:log("~w:pre_init_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,State]}}), + ct:log("~w:pre_init_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Config, State}. %% @doc Called after each init_per_group. %% You can change the return value in this function. --spec post_init_per_group(Group :: atom(), +-spec post_init_per_group(Suite :: atom(), + Group :: atom(), Config :: config(), Return :: config() | skip_or_fail(), State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_init_per_group, - [Group,Config,Return,State]}}), - ct:log("~w:post_init_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,Return,State]}}), + ct:log("~w:post_init_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Return, State}. %% @doc Called after each end_per_group. The config/state can be changed here, %% though it will only affect the *end_per_group functions. --spec pre_end_per_group(Group :: atom(), +-spec pre_end_per_group(Suite :: atom(), + Group :: atom(), Config :: config() | skip_or_fail(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_end_per_group, - [Group,Config,State]}}), - ct:log("~w:pre_end_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,State]}}), + ct:log("~w:pre_end_per_group(~w~w) called", [?MODULE,Suite,Group]), {Config, State}. %% @doc Called after each end_per_group. Note that the config cannot be %% changed here, only the status of the group. --spec post_end_per_group(Group :: atom(), +-spec post_end_per_group(Suite :: atom(), + Group :: atom(), Config :: config(), Return :: term(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_end_per_group, - [Group,Config,Return,State]}}), - ct:log("~w:post_end_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,Return,State]}}), + ct:log("~w:post_end_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Return, State}. %% @doc Called before init_per_testcase/2 for each test case. %% You can change the config in this function. --spec pre_init_per_testcase(TC :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_init_per_testcase(Suite :: atom(), + TC :: atom(), + Config :: config(), + State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_init_per_testcase, - [TC,Config,State]}}), - ct:log("~w:pre_init_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,State]}}), + ct:log("~w:pre_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Config, State}. %% @doc Called after init_per_testcase/2, and before the test case. --spec post_init_per_testcase(TC :: atom(), +-spec post_init_per_testcase(Suite :: atom(), + TC :: atom(), Config :: config(), Return :: config() | skip_or_fail(), State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_testcase(TC,Config,Return,State) -> +post_init_per_testcase(Suite,TC,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_init_per_testcase, - [TC,Config,Return,State]}}), - ct:log("~w:post_init_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,Return,State]}}), + ct:log("~w:post_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Return, State}. %% @doc Called before end_per_testacse/2. No skip or fail allowed here, %% only config additions. --spec pre_end_per_testcase(TC :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_end_per_testcase(Suite :: atom(), + TC :: atom(), + Config :: config(), + State :: #state{}) -> {config(), NewState :: #state{}}. -pre_end_per_testcase(TC,Config,State) -> +pre_end_per_testcase(Suite,TC,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_end_per_testcase, - [TC,Config,State]}}), - ct:log("~w:pre_end_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,State]}}), + ct:log("~w:pre_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Config, State}. %% @doc Called after end_per_testcase/2 for each test case. Note that %% the config cannot be changed here, only the status of the test case. --spec post_end_per_testcase(TC :: atom(), +-spec post_end_per_testcase(Suite :: atom(), + TC :: atom(), Config :: config(), Return :: term(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_end_per_testcase, - [TC,Config,Return,State]}}), - ct:log("~w:post_end_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,Return,State]}}), + ct:log("~w:post_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Return, State}. %% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group, %% post_end_per_group and post_end_per_tc if the suite, group or test case failed. %% This function should be used for extra cleanup which might be needed. %% It is not possible to modify the config or the status of the test run. --spec on_tc_fail(TC :: init_per_suite | end_per_suite | +-spec on_tc_fail(Suite :: atom(), + TC :: init_per_suite | end_per_suite | init_per_group | end_per_group | atom() | {Function :: atom(), GroupName :: atom()}, Reason :: term(), State :: #state{}) -> NewState :: #state{}. -on_tc_fail(TC, Reason, State) -> +on_tc_fail(Suite, TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, on_tc_fail, - [TC,Reason,State]}}), - ct:log("~w:on_tc_fail(~w) called", [?MODULE,TC]), + [Suite,TC,Reason,State]}}), + ct:log("~w:on_tc_fail(~w,~w) called", [?MODULE,Suite,TC]), State. %% @doc Called when a test case is skipped by either user action %% or due to an init function failing. Test case can be %% end_per_suite, init_per_group, end_per_group and the actual test cases. --spec on_tc_skip(TC :: end_per_suite | +-spec on_tc_skip(Suite :: atom(), + TC :: end_per_suite | init_per_group | end_per_group | atom() | {Function :: atom(), GroupName :: atom()}, {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), Reason :: term()}}} | {tc_user_skip, {skipped, Reason :: term()}}, State :: #state{}) -> NewState :: #state{}. -on_tc_skip(TC, Reason, State) -> +on_tc_skip(Suite, TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, on_tc_skip, - [TC,Reason,State]}}), - ct:log("~w:on_tc_skip(~w) called", [?MODULE,TC]), + [Suite,TC,Reason,State]}}), + ct:log("~w:on_tc_skip(~w,~w) called", [?MODULE,Suite,TC]), State. %% @doc Called when the scope of the CTH is done, this depends on diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl index 559b22bc9f..141b933697 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl @@ -45,29 +45,29 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl index 51202443bf..07d7c84ed5 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl @@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl new file mode 100644 index 0000000000..59a3d5cbf9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl @@ -0,0 +1,81 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(fallback_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Group,Config,State) -> + empty_cth:pre_init_per_group(fallback_nosuite,Group,Config,State). + +post_init_per_group(Group,Config,Return,State) -> + empty_cth:post_init_per_group(fallback_nosuite,Group,Config,Return,State). + +pre_end_per_group(Group,Config,State) -> + empty_cth:pre_end_per_group(fallback_nosuite,Group,Config,State). + +post_end_per_group(Group,Config,Return,State) -> + empty_cth:post_end_per_group(fallback_nosuite,Group,Config,Return,State). + +pre_init_per_testcase(TC,Config,State) -> + empty_cth:pre_init_per_testcase(fallback_nosuite,TC,Config,State). + +post_init_per_testcase(TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(fallback_nosuite,TC,Config,Return,State). + +pre_end_per_testcase(TC,Config,State) -> + empty_cth:pre_end_per_testcase(fallback_nosuite,TC,Config,State). + +post_end_per_testcase(TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(fallback_nosuite,TC,Config,Return,State). + +on_tc_fail(TC, Reason, State) -> + empty_cth:on_tc_fail(fallback_nosuite,TC,Reason,State). + +on_tc_skip(TC, Reason, State) -> + empty_cth:on_tc_skip(fallback_nosuite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl index b49cbe7fb4..679f076f3a 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl @@ -29,13 +29,13 @@ %% CT Hooks -export([init/2]). -export([terminate/1]). --export([on_tc_skip/3]). +-export([on_tc_skip/4]). init(Id, Opts) -> empty_cth:init(Id, Opts). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite, TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl index a687743641..95bb76b4c1 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl @@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl index 4d9c60f1ca..3562d39967 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl @@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl new file mode 100644 index 0000000000..fded4c02ab --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl @@ -0,0 +1,42 @@ +%% +%% %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(repeat_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case_1, test_case_2]. + +%% Test cases starts here. +test_case_1(_Config) -> + timer:sleep(10000), + ok. + +test_case_2(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl index 494f398fc1..b9d9d4cec1 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl @@ -48,35 +48,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl new file mode 100644 index 0000000000..6d1302fd35 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl @@ -0,0 +1,45 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(seq_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [{sequence,seq1}]. + +sequences() -> + [{seq1,[test_case_1,test_case_2]}]. + +%% Test cases starts here. +test_case_1(_Config) -> + exit(failed_on_purpose). + +test_case_2(_Config) -> + ct:fail("This test shall never be run since test_case_1 fails " + "and they are run in sequence"). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec new file mode 100644 index 0000000000..a271c5e8b2 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec @@ -0,0 +1,8 @@ +{suites,".",[all_hook_callbacks_SUITE, + skip_init_SUITE, + skip_req_SUITE, + skip_fail_SUITE, + skip_group_SUITE, + skip_case_SUITE]}. +{skip_suites,".",all_hook_callbacks_SUITE,"Skipped in spec"}. +{skip_cases,".",skip_case_SUITE,skip_in_spec,"Skipped in spec"}. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl new file mode 100644 index 0000000000..dad80ae914 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl @@ -0,0 +1,106 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(skip_case_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(skip_in_init,Config) -> + {skip,"Skipped in init_per_testcase/2"}; +init_per_testcase(fail_in_init,Config) -> + ct:fail("Failed in init_per_testcase/2"); +init_per_testcase(exit_in_init,Config) -> + exit(self(),"Exit in init_per_testcase/2"); +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(fail_in_end,_) -> + ct:fail("Failed in end_per_testcase/2"); +end_per_testcase(exit_in_end,_) -> + exit(self(),"Exit in end_per_testcase/2"); +end_per_testcase(_,_) -> + ok. + +all() -> + [skip_in_spec, + skip_in_init, + fail_in_init, + exit_in_init, + fail_in_end, + exit_in_end, + skip_in_case, + req_auto_skip, + fail_auto_skip + ]. + +%% Test cases starts here. +skip_in_spec(Config) -> + ct:fail("This test shall never be run. " + "It shall be skipped in the test spec."). + +skip_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall be skipped in init_per_testcase/2."). + +fail_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall fail in init_per_testcase/2."). + +exit_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall exit in init_per_testcase/2."). + +fail_in_end(Config) -> + ok. + +exit_in_end(Config) -> + ok. + +skip_in_case(Config) -> + {skip,"Skipped in test case function"}. + +req_auto_skip() -> + [{require,whatever}]. +req_auto_skip(Config) -> + ct:fail("This test shall never be run due to " + "failed require"). + +fail_auto_skip() -> + faulty_return_value. +fail_auto_skip(Config) -> + ct:fail("This test shall never be run due to " + "faulty return from info function"). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl new file mode 100644 index 0000000000..16f015fe7a --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl @@ -0,0 +1,182 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(skip_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +%% Send a cth_error event if a callback is called with unexpected arguments +-define(fail(Info), + gen_event:notify( + ?CT_EVMGR_REF, + #event{ name = cth_error, + node = node(), + data = {illegal_hook_callback,{?MODULE,?FUNCTION_NAME,Info}}})). + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + Suite==skip_init_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==skip_case_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + Suite==skip_init_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==skip_case_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + Suite==skip_case_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + Suite==skip_case_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + (Suite==skip_group_SUITE andalso Group==test_group_3) + orelse ?fail({Suite,Group}), + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + (Suite==skip_group_SUITE andalso Group==test_group_3) + orelse ?fail({Suite,Group}), + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + ?fail({Suite,Group}), + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + ?fail({Suite,Group}), + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_init + orelse TC==fail_in_init + orelse TC==exit_in_init + orelse TC==fail_in_end + orelse TC==exit_in_end + orelse TC==skip_in_case)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). + +post_init_per_testcase(Suite,TC,Config,Return,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_init + orelse TC==fail_in_init + orelse TC==exit_in_init + orelse TC==fail_in_end + orelse TC==exit_in_end + orelse TC==skip_in_case)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_case + orelse TC==fail_in_end + orelse TC==exit_in_end)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_case + orelse TC==fail_in_end + orelse TC==exit_in_end)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC,Reason,State) -> + (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==config_clash_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(all_hook_callbacks_SUITE=Suite,all=TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) + when (Suite==skip_init_SUITE + orelse Suite==skip_req_SUITE + orelse Suite==skip_fail_SUITE) + andalso + (TC==init_per_suite + orelse TC==test_case + orelse TC==end_per_suite) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(skip_group_SUITE=Suite,TC={C,G},Reason,State) + when (C==init_per_group orelse C==test_case orelse C==end_per_group) andalso + (G==test_group_1 orelse G==test_group_2 orelse G==test_group_3) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(skip_case_SUITE=Suite,TC,Reason,State) + when TC==skip_in_spec; + TC==skip_in_init; + TC==fail_in_init; + TC==exit_in_init; + TC==skip_in_case; + TC==req_auto_skip; + TC==fail_auto_skip -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) + when (Suite==seq_SUITE andalso TC==test_case_2) + orelse (Suite==repeat_SUITE andalso TC==test_case_2) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) -> + ?fail({Suite,TC}), + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl new file mode 100644 index 0000000000..9f5dfee6b9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(skip_fail_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + faulty_return_value. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl new file mode 100644 index 0000000000..d3b848bfbd --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(skip_group_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +group(test_group_1) -> + [{require,whatever}]; +group(test_group_2) -> + faulty_return_value; +group(_) -> + []. + +init_per_group(test_group_3,Config) -> + {skip,"Skipped in init_per_group/2"}; +init_per_group(_,Config) -> + ct:fail("This shall never be run due to auto_skip from group/1"). + +end_per_group(_,_) -> + ct:fail("This shall never be run"). + +all() -> + [{group,test_group_1}, + {group,test_group_2}, + {group,test_group_3}]. + +groups() -> + [{test_group_1,[test_case]}, + {test_group_2,[test_case]}, + {test_group_3,[test_case]}]. + +%% Test cases starts here. +test_case(_Config) -> + ct:fail("This test case shall never be run due to skip on group level"). + diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl new file mode 100644 index 0000000000..70305421ac --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(skip_init_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + {skip,"Skipped in init_per_suite/1"}. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl index d5b347e723..48a2d70e22 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl @@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl index 36abac0bf8..d638954d3c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl @@ -46,36 +46,36 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {{skip, "Test skip"}, State}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl new file mode 100644 index 0000000000..e1d261d59a --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(skip_pre_init_tc_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + + +%% CT Hooks +-compile(export_all). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), + {{skip, "Skipped in pre_init_per_testcase"}, State}. + +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl index fa510b2d54..d7b07ee33c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl @@ -46,35 +46,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl new file mode 100644 index 0000000000..bc69dd5ea4 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(skip_req_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + [{require,whatever}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl index 7ec0d458b6..c6e0419c50 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl @@ -48,44 +48,44 @@ post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State), {Return, [post_end_per_suite|State]}. -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State), +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State), {Config, [pre_init_per_group|State]}. -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State), +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State), {Return, [post_init_per_group|State]}. -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {Config, [pre_end_per_group|State]}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State), +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State), {Return, [post_end_per_group|State]}. -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State), +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), {Config, [pre_init_per_testcase|State]}. -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State), +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State), {Return, [post_init_per_testcase|State]}. -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State), +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State), {Config, [pre_end_per_testcase|State]}. -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State), +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State), {Return, [post_end_per_testcase|State]}. -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State), +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State), [on_tc_fail|State]. -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State), +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State), [on_tc_skip|State]. terminate(State) -> diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl index 2b9e726819..10a7047899 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl @@ -44,35 +44,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index d48981f667..f933c7702e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -50,43 +50,43 @@ post_end_per_suite(Suite,Config,Return,State) -> NewConfig = [{post_end_per_suite,?now}|Config], {NewConfig,NewConfig}. -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State), +pre_init_per_group(Suite, Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State), {[{pre_init_per_group,?now}|Config],State}. -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State), +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State), {[{post_init_per_group,?now}|Return],State}. -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {[{pre_end_per_group,?now}|Config],State}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State), +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State), {[{post_end_per_group,?now}|Config],State}. -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State), +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), {[{pre_init_per_testcase,?now}|Config],State}. -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State), +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State), {[{post_init_per_testcase,?now}|Config],State}. -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State), +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State), {[{pre_end_per_testcase,?now}|Config],State}. -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State), +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State), {[{post_end_per_testcase,?now}|Config],State}. -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl index 71d84781e0..b29256a77e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl @@ -60,37 +60,37 @@ post_end_per_suite(Suite,Config,Return,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> true = ?val(post_init_per_suite, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:pre_init_per_group(Group, + empty_cth:pre_init_per_group(Suite,Group, [{pre_init_per_group,true} | Config], State). -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> true = ?val(pre_init_per_group, Return), test_group = ct:get_config(group_cfg), - empty_cth:post_init_per_group(Group, + empty_cth:post_init_per_group(Suite,Group, Config, [{post_init_per_group,true} | Return], State). -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> true = ?val(post_init_per_group, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:pre_end_per_group(Group, + empty_cth:pre_end_per_group(Suite,Group, [{pre_end_per_group,true} | Config], State). -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> true = ?val(pre_end_per_group, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:post_end_per_group(Group,Config,Return,State). + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> true = ?val(post_init_per_suite, Config), case ?val(name, ?val(tc_group_properties, Config)) of undefined -> @@ -102,19 +102,19 @@ pre_init_per_testcase(TC,Config,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"), TC = ct:get_config(CfgKey), - empty_cth:pre_init_per_testcase(TC, + empty_cth:pre_init_per_testcase(Suite,TC, [{pre_init_per_testcase,true} | Config], State). %%! TODO: Verify Config also in post_init and pre_end! -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> true = ?val(post_init_per_suite, Config), true = ?val(pre_init_per_testcase, Config), case ?val(name, ?val(tc_group_properties, Config)) of @@ -127,13 +127,13 @@ post_end_per_testcase(TC,Config,Return,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"), TC = ct:get_config(CfgKey), - empty_cth:post_end_per_testcase(TC,Config,Return,State). + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl index 9abd2e5e83..42e086b96e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl @@ -62,43 +62,43 @@ post_end_per_suite(Suite,Config,Return,State) -> check_dirs(State,Config), empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> check_dirs(State,Config), - empty_cth:pre_init_per_group(Group,Config,State). + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> check_dirs(State,Return), - empty_cth:post_init_per_group(Group,Config,Return,State). + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> check_dirs(State,Config), - empty_cth:pre_end_per_group(Group,Config,State). + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_end_per_group(Group,Config,Return,State). + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> check_dirs(State,Config), - empty_cth:pre_init_per_testcase(TC,Config,State). + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> +post_init_per_testcase(Suite,TC,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_init_per_testcase(TC,Config,Return,State). + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> +pre_end_per_testcase(Suite,TC,Config,State) -> check_dirs(State,Config), - empty_cth:pre_end_per_testcase(TC,Config,State). + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_end_per_testcase(TC,Config,Return,State). + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE.erl index f8b6a379f6..76611a2db3 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE.erl @@ -363,14 +363,17 @@ skip_first_tc1(Suite) -> {?eh,tc_start,{Suite,tc1}}, {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{'_',0,{0,0}}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,1}}}, + {?eh,tc_start,{Suite,{init_per_group,g,[]}}}, {?eh,tc_done,{Suite,{init_per_group,g,[]},?skipped}}, {?eh,tc_auto_skip,{Suite,{tc1,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,2}}}, {?eh,tc_auto_skip,{Suite,{tc2,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,3}}}, {?eh,tc_auto_skip,{Suite,{end_per_group,g},?skip_reason}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,4}}}, {?eh,tc_start,{Suite,end_per_suite}}, @@ -390,10 +393,12 @@ skip_tc1_in_group(Suite) -> {?eh,tc_start,{Suite,tc1}}, {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{'_',0,{0,0}}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,1}}}, {?eh,tc_start,{Suite,{end_per_group,g,[]}}}, {?eh,tc_done,{Suite,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,2}}}, {?eh,tc_start,{Suite,end_per_suite}}, diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index 42ec685c16..884217afc2 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -73,7 +73,9 @@ all() -> relative_path, url, logdir, - fail_pre_init_per_suite + fail_pre_init_per_suite, + skip_case_in_spec, + skip_suite_in_spec ]. %%-------------------------------------------------------------------- @@ -119,6 +121,18 @@ fail_pre_init_per_suite(Config) when is_list(Config) -> run(fail_pre_init_per_suite,[fail_pre_init_per_suite, {cth_surefire,[{path,Path}]}],Path,Config,[],Suites). +skip_case_in_spec(Config) -> + DataDir = ?config(data_dir,Config), + Spec = filename:join(DataDir,"skip_one_case.spec"), + Path = "skip_case_in_spec.xml", + run_spec(skip_case_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec). + +skip_suite_in_spec(Config) -> + DataDir = ?config(data_dir,Config), + Spec = filename:join(DataDir,"skip_one_suite.spec"), + Path = "skip_suite_in_spec.xml", + run_spec(skip_suite_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -129,8 +143,15 @@ run(Case,CTHs,Report,Config,ExtraOpts) -> Suite = filename:join(DataDir, "surefire_SUITE"), run(Case,CTHs,Report,Config,ExtraOpts,Suite). run(Case,CTHs,Report,Config,ExtraOpts,Suite) -> - {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], - Config), + Test = [{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], + do_run(Case, Report, Test, Config). + +run_spec(Case,CTHs,Report,Config,Spec) -> + Test = [{spec,Spec},{ct_hooks,CTHs},{label,Case}], + do_run(Case, Report, Test, Config). + +do_run(Case, Report, Test, Config) -> + {Opts,ERPid} = setup(Test, Config), ok = execute(Case, Opts, ERPid, Config), LogDir = case lists:keyfind(logdir,1,Opts) of @@ -201,7 +222,10 @@ test_suite_events(pass_SUITE) -> {?eh,test_stats,{1,0,{0,0}}}, {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,tc_done,{ct_framework,end_per_suite,ok}}]; -test_suite_events(_) -> +test_suite_events(skip_all_surefire_SUITE) -> + [{?eh,tc_user_skip,{skip_all_surefire_SUITE,all,"skipped in spec"}}, + {?eh,test_stats,{0,0,{1,0}}}]; +test_suite_events(Test) -> [{?eh,tc_start,{surefire_SUITE,init_per_suite}}, {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, {?eh,tc_start,{surefire_SUITE,tc_ok}}, @@ -210,46 +234,55 @@ test_suite_events(_) -> {?eh,tc_start,{surefire_SUITE,tc_fail}}, {?eh,tc_done,{surefire_SUITE,tc_fail, {failed,{error,{test_case_failed,"this test should fail"}}}}}, - {?eh,test_stats,{1,1,{0,0}}}, - {?eh,tc_start,{surefire_SUITE,tc_skip}}, - {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, - {?eh,test_stats,{1,1,{1,0}}}, - {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, - {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, - {auto_skipped,{require_failed,'_'}}}}, - {?eh,test_stats,{1,1,{1,1}}}, - [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}}, - {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}}, - {?eh,tc_start,{surefire_SUITE,tc_ok}}, - {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, - {?eh,test_stats,{2,1,{1,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_fail}}, - {?eh,tc_done,{surefire_SUITE,tc_fail, - {failed,{error,{test_case_failed,"this test should fail"}}}}}, - {?eh,test_stats,{2,2,{1,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_skip}}, - {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, - {?eh,test_stats,{2,2,{2,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, - {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, - {auto_skipped,{require_failed,'_'}}}}, - {?eh,test_stats,{2,2,{2,2}}}, - {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}}, - {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}], - [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, - {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, - {failed,{error,all_cases_should_be_skipped}}}}, - {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail}, - {failed, - {surefire_SUITE,init_per_group, - {'EXIT',all_cases_should_be_skipped}}}}}, - {?eh,test_stats,{2,2,{2,3}}}, - {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail}, - {failed, - {surefire_SUITE,init_per_group, - {'EXIT',all_cases_should_be_skipped}}}}}], - {?eh,tc_start,{surefire_SUITE,end_per_suite}}, - {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + {?eh,test_stats,{1,1,{0,0}}}] ++ + tc_skip_events(Test,undefined) ++ + [{?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {auto_skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{1,1,{1,1}}}, + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{surefire_SUITE,tc_ok}}, + {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, + {?eh,test_stats,{2,1,{1,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_fail}}, + {?eh,tc_done,{surefire_SUITE,tc_fail, + {failed,{error,{test_case_failed,"this test should fail"}}}}}, + {?eh,test_stats,{2,2,{1,1}}}] ++ + tc_skip_events(Test,g) ++ + [{?eh,test_stats,{2,2,{2,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {auto_skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{2,2,{2,2}}}, + {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}], + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, + {failed,{error,all_cases_should_be_skipped}}}}, + {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail}, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}, + {?eh,test_stats,{2,2,{2,3}}}, + {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail}, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}], + {?eh,tc_start,{surefire_SUITE,end_per_suite}}, + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + +tc_skip_events(skip_case_in_spec,Group) -> + [{?eh,tc_user_skip,{surefire_SUITE,tc_skip_name(Group),"skipped in spec"}}]; +tc_skip_events(_Test,_Group) -> + [{?eh,tc_start,{surefire_SUITE,tc_skip}}, + {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}]. + +tc_skip_name(undefined) -> + tc_skip; +tc_skip_name(Group) -> + {tc_skip,Group}. test_events(fail_pre_init_per_suite) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, @@ -257,6 +290,10 @@ test_events(fail_pre_init_per_suite) -> test_suite_events(pass_SUITE) ++ test_suite_events(fail_SUITE, {1,0,{0,1}}) ++ [{?eh,stop_logging,[]}]; +test_events(skip_suite_in_spec) -> + [{?eh,start_logging,'_'},{?eh,start_info,{1,1,0}}] ++ + test_suite_events(skip_all_surefire_SUITE) ++ + [{?eh,stop_logging,[]}]; test_events(Test) -> [{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++ test_suite_events(Test) ++ @@ -364,6 +401,8 @@ failed_or_skipped([]) -> events_to_result(E) -> events_to_result(E, []). +events_to_result([{?eh,tc_user_skip,{_Suite,all,_}}|E], Result) -> + events_to_result(E, [[[s]]|Result]); events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) -> {Suite,Rest} = events_to_result1(E), events_to_result(Rest, [[[s]|Suite]|Result]); @@ -382,7 +421,7 @@ events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) -> events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> {Suite,Rest} = events_to_result1(E), {[result(R)|Suite],Rest}; -events_to_result1([{?eh,tc_auto_skip,_}|E]) -> +events_to_result1([{?eh,Skip,_}|E]) when Skip==tc_auto_skip; Skip==tc_user_skip -> {Suite,Rest} = events_to_result1(E), {[[s]|Suite],Rest}; events_to_result1([_|E]) -> diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec new file mode 100644 index 0000000000..42df8a7d1a --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec @@ -0,0 +1,2 @@ +{suites,".",surefire_SUITE}. +{skip_cases,".",surefire_SUITE,tc_skip,"skipped in spec"}. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec new file mode 100644 index 0000000000..57966328ab --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec @@ -0,0 +1,2 @@ +{suites,".",[skip_all_surefire_SUITE]}. +{skip_suites,".",skip_all_surefire_SUITE,"skipped in spec"}. diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index 228d900545..ea8a1a5662 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -161,6 +161,7 @@ test_events(ts_if_1) -> {?eh,tc_start,{ts_if_1_SUITE,tc4}}, {?eh,tc_done,{ts_if_1_SUITE,tc4,{failed,{error,failed_on_purpose}}}}, {?eh,test_stats,{1,2,{0,1}}}, + {?eh,tc_start,{ts_if_1_SUITE,tc5}}, {?eh,tc_done,{ts_if_1_SUITE,tc5,{auto_skipped,{sequence_failed,seq1,tc4}}}}, {?eh,test_stats,{1,2,{0,2}}}, diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index e926abd885..05a452b99d 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -765,23 +765,23 @@ locate({parallel,TEvs}, Node, Evs, Config) -> {Done,RemEvs2,length(RemEvs2)} end; %% end_per_group auto- or user skipped - (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize}) + (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize}) when AutoOrUserSkip == tc_auto_skip; AutoOrUserSkip == tc_user_skip -> RemEvs1 = lists:dropwhile( fun({EH,#event{name=tc_auto_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G -> case match_data(R, Reason) of match -> false; _ -> true end; ({EH,#event{name=tc_user_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G -> case match_data(R, Reason) of match -> false; _ -> true @@ -1008,20 +1008,20 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> {Done,RemEvs2,length(RemEvs2)} end; %% end_per_group auto-or user skipped - (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize}) + (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize}) when AutoOrUserSkip == tc_auto_skip; AutoOrUserSkip == tc_user_skip -> RemEvs1 = lists:dropwhile( fun({EH,#event{name=tc_auto_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M, Reason == R -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R -> false; ({EH,#event{name=tc_user_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M, Reason == R -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R -> false; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when @@ -1264,10 +1264,10 @@ log_events1([E={_EH,tc_done,{_M,{end_per_group,_GrName,Props},_R}} | Evs], Dev, io:format(Dev, "~s~p]},~n", [Ind,E]), log_events1(Evs, Dev, Ind--" ") end; -log_events1([E={_EH,tc_auto_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) -> +log_events1([E={_EH,tc_auto_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) -> io:format(Dev, "~s~p],~n", [Ind,E]), log_events1(Evs, Dev, Ind--" "); -log_events1([E={_EH,tc_user_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) -> +log_events1([E={_EH,tc_user_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) -> io:format(Dev, "~s~p],~n", [Ind,E]), log_events1(Evs, Dev, Ind--" "); log_events1([E], Dev, Ind) -> diff --git a/lib/common_test/test/ct_testspec_2_SUITE.erl b/lib/common_test/test/ct_testspec_2_SUITE.erl index 1a941df185..1bab80942a 100644 --- a/lib/common_test/test/ct_testspec_2_SUITE.erl +++ b/lib/common_test/test/ct_testspec_2_SUITE.erl @@ -220,7 +220,24 @@ basic_compatible_no_nodes(_Config) -> {tc2,{skip,"skipped"}}]}]}], merge_tests = true}, - verify_result(Verify,ListResult,FileResult). + verify_result(Verify,ListResult,FileResult), + + {ok,Tests} = ct_testspec:get_tests([SpecFile]), + ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]), + [{[SpecFile],[{Node,Run,Skip}]}] = Tests, + [{Alias1V,x_SUITE,all}, + {Alias1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]}, + {Alias1V,z_SUITE,all}, + {Alias2V,x_SUITE,all}, + {Alias2V,y_SUITE,all}] = lists:sort(Run), + [{Alias1V,z_SUITE,"skipped"}, + {Alias2V,x_SUITE,{g1,all},"skipped"}, + {Alias2V,x_SUITE,{g2,all},"skipped"}, + {Alias2V,y_SUITE,tc1,"skipped"}, + {Alias2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip), + + ok. + %%%----------------------------------------------------------------- %%% @@ -346,7 +363,25 @@ basic_compatible_nodes(_Config) -> {tc2,{skip,"skipped"}}]}]}], merge_tests = true}, - verify_result(Verify,ListResult,FileResult). + verify_result(Verify,ListResult,FileResult), + + {ok,Tests} = ct_testspec:get_tests([SpecFile]), + ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]), + [{[SpecFile],[{Node,[],[]}, + {Node1,Run1,Skip1}, + {Node2,Run2,Skip2}]}] = Tests, + [{TO1V,x_SUITE,all}, + {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]}, + {TO1V,z_SUITE,all}] = lists:sort(Run1), + [{TO2V,x_SUITE,all}, + {TO2V,y_SUITE,all}] = lists:sort(Run2), + [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1), + [{TO2V,x_SUITE,{g1,all},"skipped"}, + {TO2V,x_SUITE,{g2,all},"skipped"}, + {TO2V,y_SUITE,tc1,"skipped"}, + {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2), + + ok. %%%----------------------------------------------------------------- %%% @@ -439,7 +474,28 @@ no_merging(_Config) -> [{y_SUITE,[{tc1,{skip,"skipped"}}, {tc2,{skip,"skipped"}}]}]}]}, - verify_result(Verify,ListResult,FileResult). + verify_result(Verify,ListResult,FileResult), + + {ok,Tests} = ct_testspec:get_tests([SpecFile]), + ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]), + [{[SpecFile],[{Node,[],[]}, + {Node1,Run1,Skip1}, + {Node2,Run2,Skip2}]}] = Tests, + [{TO1V,x_SUITE,all}, + {TO1V,y_SUITE,[tc1,tc2]}, + {TO1V,y_SUITE,[{g1,all},{g2,all}]}, + {TO1V,z_SUITE,all}] = lists:sort(Run1), + [{TO2V,x_SUITE,all}, + {TO2V,x_SUITE,[{skipped,g1,all},{skipped,g2,all}]}, + {TO2V,y_SUITE,all}, + {TO2V,y_SUITE,[{skipped,tc1},{skipped,tc2}]}] = lists:sort(Run2), + [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1), + [{TO2V,x_SUITE,{g1,all},"skipped"}, + {TO2V,x_SUITE,{g2,all},"skipped"}, + {TO2V,y_SUITE,tc1,"skipped"}, + {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2), + + ok. %%%----------------------------------------------------------------- %%% @@ -510,7 +566,25 @@ multiple_specs(_Config) -> {y_SUITE,[all,{tc1,{skip,"skipped"}}, {tc2,{skip,"skipped"}}]}]}]}, - verify_result(Verify,FileResult,FileResult). + verify_result(Verify,FileResult,FileResult), + + {ok,Tests} = ct_testspec:get_tests([[SpecFile1,SpecFile2]]), + ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]), + [{[SpecFile1,SpecFile2],[{Node,[],[]}, + {Node1,Run1,Skip1}, + {Node2,Run2,Skip2}]}] = Tests, + [{TO1V,x_SUITE,all}, + {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]}, + {TO1V,z_SUITE,all}] = lists:sort(Run1), + [{TO2V,x_SUITE,all}, + {TO2V,y_SUITE,all}] = lists:sort(Run2), + [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1), + [{TO2V,x_SUITE,{g1,all},"skipped"}, + {TO2V,x_SUITE,{g2,all},"skipped"}, + {TO2V,y_SUITE,tc1,"skipped"}, + {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2), + + ok. %%%----------------------------------------------------------------- %%% diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 3ce37b98e9..611cdc71ae 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -669,7 +669,7 @@ module.beam: module.erl \ <fsummary>Compiles a list of forms.</fsummary> <desc> <p>Is the same as - <c>forms(File, [verbose,report_errors,report_warnings])</c>. + <c>forms(Forms, [verbose,report_errors,report_warnings])</c>. </p> </desc> </func> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 434360d294..e37ca31704 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -173,17 +173,25 @@ env_default_opts() -> do_compile(Input, Opts0) -> Opts = expand_opts(Opts0), - {Pid,Ref} = - spawn_monitor(fun() -> - exit(try - internal(Input, Opts) - catch - error:Reason -> - {error,Reason} - end) - end), - receive - {'DOWN',Ref,process,Pid,Rep} -> Rep + IntFun = fun() -> try + internal(Input, Opts) + catch + error:Reason -> + {error,Reason} + end + end, + %% Dialyzer has already spawned workers. + case lists:member(dialyzer, Opts) of + true -> + IntFun(); + false -> + {Pid,Ref} = + spawn_monitor(fun() -> + exit(IntFun()) + end), + receive + {'DOWN',Ref,process,Pid,Rep} -> Rep + end end. expand_opts(Opts0) -> diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 3cb49433ce..adb96fb87d 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, @@ -32,11 +32,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> test_lib:recompile(?MODULE), [{group,p}]. -groups() -> +groups() -> [{p,test_lib:parallel(), [basic, deeply_nested, @@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) -> ok. effect(Config) when is_list(Config) -> + ct:timetrap({minutes,10}), [{42,{a,b,c}}] = do_effect(fun(F, L) -> [F({V1,V2}) || @@ -240,7 +241,7 @@ do_effect(Lc, L) -> lists:reverse(erase(?MODULE)). id(I) -> I. - + fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c100fc8ee2..ffa51bcfae 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -61,7 +61,6 @@ #include <openssl/evp.h> #include <openssl/hmac.h> - /* Helper macro to construct a OPENSSL_VERSION_NUMBER. * See openssl/opensslv.h */ @@ -326,7 +325,7 @@ static ErlNifFunc nif_funcs[] = { {"rsa_private_crypt", 4, rsa_private_crypt}, {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, {"dh_check", 1, dh_check}, - {"dh_generate_key_nif", 3, dh_generate_key_nif}, + {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, @@ -2727,12 +2726,13 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] } static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (PrivKey, DHParams=[P,G], Mpint) */ +{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ DH* dh_params; int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ + unsigned long len = 0; dh_params = DH_new(); @@ -2743,11 +2743,21 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_bin(env, head, &dh_params->g) || !enif_is_empty_list(env, tail) - || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) { + || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4) + || !enif_get_ulong(env, argv[3], &len) ) { DH_free(dh_params); return enif_make_badarg(env); } + if (len) { + if (len < BN_num_bits(dh_params->p)) + dh_params->length = len; + else { + DH_free(dh_params); + return enif_make_badarg(env); + } + } + if (DH_generate_key(dh_params)) { pub_len = BN_num_bytes(dh_params->pub_key); prv_len = BN_num_bytes(dh_params->priv_key); diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index eda0f7af51..b6a1371154 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -100,7 +100,7 @@ <code>dh_private() = key_value() </code> - <code>dh_params() = [key_value()] = [P, G] </code> + <code>dh_params() = [key_value()] = [P, G] | [P, G, PrivateKeyBitLength]</code> <code>ecdh_public() = key_value() </code> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index da8626e38a..deeb763145 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -277,10 +277,11 @@ hmac_final_n(Context, HashLen) -> des3_cbc | des3_cbf | des3_cfb | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | - aes_cbc | + aes_cbc | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); - (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}; + (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}. block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= des_cfb; @@ -546,9 +547,15 @@ exor(Bin1, Bin2) -> generate_key(Type, Params) -> generate_key(Type, Params, undefined). -generate_key(dh, DHParameters, PrivateKey) -> +generate_key(dh, DHParameters0, PrivateKey) -> + {DHParameters, Len} = + case DHParameters0 of + [P,G,L] -> {[P,G], L}; + [P,G] -> {[P,G], 0} + end, dh_generate_key_nif(ensure_int_as_bin(PrivateKey), - map_ensure_int_as_bin(DHParameters), 0); + map_ensure_int_as_bin(DHParameters), + 0, Len); generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) -> @@ -1200,11 +1207,11 @@ dh_check([_Prime,_Gen]) -> ?nif_stub. {binary(),binary()}. dh_generate_key(DHParameters) -> - dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4). + dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4, 0). dh_generate_key(PrivateKey, DHParameters) -> - dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4). + dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4, 0). -dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub. +dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% MyPrivKey, OthersPublicKey = mpint() diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 5b28f7ae86..f517c51ec1 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -48,5 +48,5 @@ {applications, [compiler, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.0", - "kernel-5.0","hipe-3.15.1","erts-8.0", + "kernel-5.0","hipe-3.15.4","erts-8.0", "compiler-7.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 08e55a78bd..4e18058993 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -101,9 +101,9 @@ loop(#server_state{parent = Parent} = State, {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); - {AnalPid, done, Plt, DocPlt} -> + {AnalPid, done, MiniPlt, DocPlt} -> send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt); + send_analysis_done(Parent, MiniPlt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> @@ -121,6 +121,7 @@ loop(#server_state{parent = Parent} = State, %% The Analysis %%-------------------------------------------------------------------- +%% Calls to erlang:garbage_collect() help to reduce the heap size. analysis_start(Parent, Analysis, LegalWarnings) -> CServer = dialyzer_codeserver:new(), Plt = Analysis#analysis.plt, @@ -157,12 +158,9 @@ analysis_start(Parent, Analysis, LegalWarnings) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), + erlang:garbage_collect(), ?timing(State#analysis_state.timing_server, "remote", - begin - TmpCServer3 = - dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) - end) + contracts_and_records(TmpCServer2)) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, @@ -171,48 +169,75 @@ analysis_start(Parent, Analysis, LegalWarnings) -> NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes), State0 = State#analysis_state{plt = NewPlt1}, dump_callgraph(Callgraph, State0, Analysis), - State1 = State0#analysis_state{codeserver = NewCServer}, %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), - Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer), + State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1}, Exports = dialyzer_codeserver:get_exports(NewCServer), + NonExports = sets:subtract(sets:from_list(AllNodes), Exports), + NonExportsList = sets:to_list(NonExports), NewCallgraph = case Analysis#analysis.race_detection of true -> dialyzer_callgraph:put_race_detection(true, Callgraph); false -> Callgraph end, - State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}), + State2 = analyze_callgraph(NewCallgraph, State1), + #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2, dialyzer_callgraph:dispose_race_server(NewCallgraph), rcv_and_send_ext_types(Parent), - NonExports = sets:subtract(sets:from_list(AllNodes), Exports), - NonExportsList = sets:to_list(NonExports), - Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList), - send_codeserver_plt(Parent, CServer, State2#analysis_state.plt), - send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt). + %% Since the PLT is never used, a dummy is sent: + DummyPlt = dialyzer_plt:new(), + send_codeserver_plt(Parent, CServer, DummyPlt), + MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList), + send_analysis_done(Parent, MiniPlt3, DocPlt). + +contracts_and_records(CodeServer) -> + Fun = contrs_and_recs(CodeServer), + {Pid, Ref} = erlang:spawn_monitor(Fun), + dialyzer_codeserver:give_away(CodeServer, Pid), + Pid ! {self(), go}, + receive {'DOWN', Ref, process, Pid, Return} -> + Return + end. + +-spec contrs_and_recs(dialyzer_codeserver:codeserver()) -> + fun(() -> no_return()). + +contrs_and_recs(TmpCServer2) -> + fun() -> + Parent = receive {Pid, go} -> Pid end, + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + TmpServer4 = + dialyzer_contracts:process_contract_remote_types(TmpCServer3, + RecordDict), + dialyzer_codeserver:give_away(TmpServer4, Parent), + exit(TmpServer4) + end. analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, doc_plt = DocPlt, + plt = Plt, timing_server = TimingServer, parent = Parent, solvers = Solvers} = State) -> - Plt = dialyzer_plt:insert_callbacks(State#analysis_state.plt, Codeserver), - {NewPlt, NewDocPlt} = - case State#analysis_state.analysis_type of - plt_build -> - NewPlt0 = - dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, - TimingServer, Solvers, Parent), - {NewPlt0, DocPlt}; - succ_typings -> - {Warnings, NewPlt0, NewDocPlt0} = - dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, - TimingServer, Solvers, Parent), - Warnings1 = filter_warnings(Warnings, Codeserver), - send_warnings(State#analysis_state.parent, Warnings1), - {NewPlt0, NewDocPlt0} - end, - dialyzer_callgraph:delete(Callgraph), - State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}. + case State#analysis_state.analysis_type of + plt_build -> + NewMiniPlt = + dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt}; + succ_typings -> + {Warnings, NewMiniPlt, NewDocPlt} = + dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + Warnings1 = filter_warnings(Warnings, Codeserver), + send_warnings(State#analysis_state.parent, Warnings1), + State#analysis_state{plt = NewMiniPlt, doc_plt = NewDocPlt} + end. %%-------------------------------------------------------------------- %% Build the callgraph and fill the codeserver. @@ -569,8 +594,9 @@ is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) -> is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) -> not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver). -send_analysis_done(Parent, Plt, DocPlt) -> - Parent ! {self(), done, Plt, DocPlt}, +send_analysis_done(Parent, MiniPlt, DocPlt) -> + ok = dialyzer_plt:give_away(MiniPlt, Parent), + Parent ! {self(), done, MiniPlt, DocPlt}, ok. send_ext_calls(_Parent, none) -> @@ -583,7 +609,7 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_codeserver_plt(Parent, CServer, Plt ) -> +send_codeserver_plt(Parent, CServer, Plt) -> Parent ! {self(), cserver, CServer, Plt}, ok. @@ -602,14 +628,14 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc) format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) -> {_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer), Msg = {call_to_missing, [M, F, A]}, - {File, Line} = find_call_file_and_line(FunCode, To), + {File, Line} = find_call_file_and_line(FromMFA, FunCode, To, CodeServer), WarningInfo = {File, Line, FromMFA}, NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc], format_bad_calls(Left, CodeServer, NewAcc); format_bad_calls([], _CodeServer, Acc) -> Acc. -find_call_file_and_line(Tree, MFA) -> +find_call_file_and_line({Module, _, _}, Tree, MFA, CodeServer) -> Fun = fun(SubTree, Acc) -> case cerl:is_c_call(SubTree) of @@ -622,7 +648,7 @@ find_call_file_and_line(Tree, MFA) -> case {cerl:concrete(M), cerl:concrete(F), A} of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), get_line(Ann)}|Acc]; {erlang, make_fun, 3} -> [CA1, CA2, CA3] = cerl:call_args(SubTree), case @@ -638,7 +664,8 @@ find_call_file_and_line(Tree, MFA) -> of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), + get_line(Ann)}|Acc]; _ -> Acc end; @@ -658,8 +685,10 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). -spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) -> 'ok'. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 5623929a43..524ae047e2 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -62,9 +62,9 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) -> _ -> MFA = {Module,module_info,0}, {_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - File = get_file(cerl:get_ann(Code)), + File = get_file(Codeserver, Module, cerl:get_ann(Code)), State = #state{plt = Plt, filename = File, behlines = BehLines, - codeserver = Codeserver, records = Records}, + codeserver = Codeserver, records = Records}, Warnings = get_warnings(Module, Behaviours, State), [add_tag_warning_info(Module, W, State) || W <- Warnings] end. @@ -213,12 +213,15 @@ add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity}, State#state.codeserver), Anns = cerl:get_ann(FunCode), - WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}}, + File = get_file(State#state.codeserver, Module, Anns), + WarningInfo = {File, get_line(Anns), {Module, Fun, Arity}}, {?WARN_BEHAVIOUR, WarningInfo, Warn}. get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 50abb22009..5e02e7a2cc 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -119,7 +119,11 @@ -opaque callgraph() :: #callgraph{}. --type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. +-type active_digraph() :: {'d', digraph:graph()} + | {'e', + Out :: ets:tid(), + In :: ets:tid(), + Map :: ets:tid()}. %%---------------------------------------------------------------------- @@ -248,24 +252,30 @@ find_non_local_calls([], Set) -> -spec get_depends_on(scc() | module(), callgraph()) -> [scc()]. -get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In}}) -> - case ets_lookup_dict(SCC, Out) of - {ok, Value} -> Value; - error -> [] - end; +get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) -> + lookup_scc(SCC, Out, Maps); get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:out_neighbours(DG, SCC). -spec get_required_by(scc() | module(), callgraph()) -> [scc()]. -get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In}}) -> - case ets_lookup_dict(SCC, In) of - {ok, Value} -> Value; - error -> [] - end; +get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) -> + lookup_scc(SCC, In, Maps); get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:in_neighbours(DG, SCC). +lookup_scc(SCC, Table, Maps) -> + case ets_lookup_dict({'scc', SCC}, Maps) of + {ok, SCCInt} -> + case ets_lookup_dict(SCCInt, Table) of + {ok, Ints} -> + [ets:lookup_element(Maps, Int, 2) || Int <- Ints]; + error -> + [] + end; + error -> [] + end. + %%---------------------------------------------------------------------- %% Handling of modules & SCCs %%---------------------------------------------------------------------- @@ -582,9 +592,10 @@ digraph_delete(DG) -> active_digraph_delete({'d', DG}) -> digraph:delete(DG); -active_digraph_delete({'e', Out, In}) -> +active_digraph_delete({'e', Out, In, Maps}) -> ets:delete(Out), - ets:delete(In). + ets:delete(In), + ets:delete(Maps). digraph_edges(DG) -> digraph:edges(DG). @@ -758,37 +769,28 @@ to_ps(#callgraph{} = CG, File, Args) -> ok. condensation(G) -> - SCs = digraph_utils:strong_components(G), - V2I = ets:new(condensation_v2i, []), - I2C = ets:new(condensation_i2c, []), - I2I = ets:new(condensation_i2i, [bag]), - CFun = - fun(SC, N) -> - lists:foreach(fun(V) -> true = ets:insert(V2I, {V,N}) end, SC), - true = ets:insert(I2C, {N, SC}), - N + 1 - end, - lists:foldl(CFun, 1, SCs), - Fun1 = - fun({V1, V2}) -> - I1 = ets:lookup_element(V2I, V1, 2), - I2 = ets:lookup_element(V2I, V2, 2), - I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) - end, - lists:foreach(Fun1, digraph:edges(G)), - Fun3 = - fun({I1, I2}, {Out, In}) -> - SC1 = ets:lookup_element(I2C, I1, 2), - SC2 = ets:lookup_element(I2C, I2, 2), - {dict:append(SC1, SC2, Out), dict:append(SC2, SC1, In)} - end, - {OutDict, InDict} = ets:foldl(Fun3, {dict:new(), dict:new()}, I2I), - [OutETS, InETS] = + SCCs = digraph_utils:strong_components(G), + %% Assign unique numbers to SCCs: + Ints = lists:seq(1, length(SCCs)), + IntToSCC = lists:zip(Ints, SCCs), + IntScc = sofs:relation(IntToSCC, [{int, scc}]), + %% Subsitute strong components for vertices in edges using the + %% unique numbers: + C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]), + I2V = sofs:relative_product(IntScc, C2V), % [{v, int}] + Es = sofs:relation(digraph:edges(G), [{v, v}]), + R1 = sofs:relative_product(I2V, Es), + R2 = sofs:relative_product(I2V, sofs:converse(R1)), + %% Create in- and out-neighbours: + In = sofs:relation_to_family(sofs:strict_relation(R2)), + R3 = sofs:converse(R2), + Out = sofs:relation_to_family(sofs:strict_relation(R3)), + [OutETS, InETS, MapsETS] = [ets:new(Name,[{read_concurrency, true}]) || - Name <- [callgraph_deps_out, callgraph_deps_in]], - ets:insert(OutETS, dict:to_list(OutDict)), - ets:insert(InETS, dict:to_list(InDict)), - ets:delete(V2I), - ets:delete(I2C), - ets:delete(I2I), - {{'e', OutETS, InETS}, SCs}. + Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]], + ets:insert(OutETS, sofs:to_external(Out)), + ets:insert(InETS, sofs:to_external(In)), + %% Create mappings from SCCs to unique integers, and the inverse: + ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)), + ets:insert(MapsETS, IntToSCC), + {{'e', OutETS, InETS, MapsETS}, SCCs}. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index fc56693ea3..e8c1613a33 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -637,8 +637,8 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, done, NewPlt, _NewDocPlt} -> - return_value(State, NewPlt); + {BackendPid, done, NewMiniPlt, _NewDocPlt} -> + return_value(State, NewMiniPlt); {BackendPid, ext_calls, ExtCalls} -> cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache); {BackendPid, ext_types, ExtTypes} -> @@ -654,6 +654,7 @@ cl_loop(State, LogCache) -> cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), + %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored. cl_loop(State, LogCache) end. @@ -699,10 +700,13 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, output_plt = OutputPlt, plt_info = PltInfo, stored_warnings = StoredWarnings}, - Plt) -> + MiniPlt) -> case OutputPlt =:= none of - true -> ok; - false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) + true -> + dialyzer_plt:delete(MiniPlt); + false -> + Plt = dialyzer_plt:restore_full_plt(MiniPlt), + dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) end, UnknownWarnings = unknown_warnings(State), RetValue = diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 03cd9671af..a5bb4e209c 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -29,7 +29,9 @@ -module(dialyzer_codeserver). -export([delete/1, - finalize_contracts/3, + store_temp_contracts/4, + give_away/2, + finalize_contracts/1, finalize_exported_types/2, finalize_records/2, get_contracts/1, @@ -38,7 +40,9 @@ get_exports/1, get_records/1, get_next_core_label/1, - get_temp_contracts/1, + get_temp_contracts/2, + contracts_modules/1, + store_contracts/4, get_temp_exported_types/1, get_temp_records/1, insert/3, @@ -48,6 +52,7 @@ is_exported/2, lookup_mod_code/2, lookup_mfa_code/2, + lookup_mfa_var_label/2, lookup_mod_records/2, lookup_mod_contracts/2, lookup_mfa_contract/2, @@ -56,21 +61,22 @@ set_next_core_label/2, set_temp_records/2, store_temp_records/3, - store_temp_contracts/4]). + translate_fake_file/3]). --export_type([codeserver/0, fun_meta_info/0]). +-export_type([codeserver/0, fun_meta_info/0, contracts/0]). -include("dialyzer.hrl"). %%-------------------------------------------------------------------- -type dict_ets() :: ets:tid(). +-type map_ets() :: ets:tid(). -type set_ets() :: ets:tid(). -type types() :: erl_types:type_table(). --type mod_records() :: dict:dict(module(), types()). +-type mod_records() :: erl_types:mod_records(). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}. -type mod_contracts() :: dict:dict(module(), contracts()). %% A property-list of data compiled from -compile and -dialyzer attributes. @@ -81,16 +87,16 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets() | 'undefined', % set(mfa()) - records :: dict_ets() | 'undefined', - contracts :: dict_ets() | 'undefined', - callbacks :: dict_ets() | 'undefined', + exported_types :: set_ets(), % set(mfa()) + records :: map_ets(), + contracts :: map_ets(), + callbacks :: map_ets(), fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) - temp_records :: 'clean' | dict_ets(), - temp_contracts :: 'clean' | dict_ets(), - temp_callbacks :: 'clean' | dict_ets() + temp_records :: 'clean' | map_ets(), + temp_contracts :: 'clean' | map_ets(), + temp_callbacks :: 'clean' | map_ets() }). -opaque codeserver() :: #codeserver{}. @@ -104,7 +110,7 @@ ets_dict_find(Key, Table) -> _:_ -> error end. -ets_dict_store(Key, Element, Table) -> +ets_map_store(Key, Element, Table) -> true = ets:insert(Table, {Key, Element}), Table. @@ -128,9 +134,6 @@ ets_set_to_set(Table) -> Fold = fun({E}, Set) -> sets:add_element(E, Set) end, ets:foldl(Fold, sets:new(), Table). -ets_read_concurrent_table(Name) -> - ets:new(Name, [{read_concurrency, true}]). - %%-------------------------------------------------------------------- -spec new() -> codeserver(). @@ -138,6 +141,13 @@ ets_read_concurrent_table(Name) -> new() -> CodeOptions = [compressed, public, {read_concurrency, true}], Code = ets:new(dialyzer_codeserver_code, CodeOptions), + ReadOptions = [compressed, {read_concurrency, true}], + [Contracts, Callbacks, Records, ExportedTypes] = + [ets:new(Name, ReadOptions) || + Name <- [dialyzer_codeserver_contracts, + dialyzer_codeserver_callbacks, + dialyzer_codeserver_records, + dialyzer_codeserver_exported_types]], TempOptions = [public, {write_concurrency, true}], [Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts, TempCallbacks] = @@ -150,6 +160,10 @@ new() -> #codeserver{code = Code, exports = Exports, fun_meta_info = FunMetaInfo, + exported_types = ExportedTypes, + records = Records, + contracts = Contracts, + callbacks = Callbacks, temp_exported_types = TempExportedTypes, temp_records = TempRecords, temp_contracts = TempContracts, @@ -170,13 +184,15 @@ insert(Mod, ModCode, CS) -> Exports = cerl:module_exports(ModCode), Attrs = cerl:module_attrs(ModCode), Defs = cerl:module_defs(ModCode), + {Files, SmallDefs} = compress_file_anno(Defs), As = cerl:get_ann(ModCode), Funs = [{{Mod, cerl:fname_id(Var), cerl:fname_arity(Var)}, - Val} || Val = {Var, _Fun} <- Defs], - Keys = [Key || {Key, _Value} <- Funs], + Val, {Var, cerl_trees:get_label(Fun)}} || Val = {Var, Fun} <- SmallDefs], + Keys = [Key || {Key, _Value, _Label} <- Funs], ModEntry = {Mod, {Name, Exports, Attrs, Keys, As}}, - true = ets:insert(CS#codeserver.code, [ModEntry|Funs]), + ModFileEntry = {{mod, Mod}, Files}, + true = ets:insert(CS#codeserver.code, [ModEntry, ModFileEntry|Funs]), CS. -spec get_temp_exported_types(codeserver()) -> sets:set(mfa()). @@ -220,12 +236,12 @@ get_exports(#codeserver{exports = Exports}) -> -spec finalize_exported_types(sets:set(mfa()), codeserver()) -> codeserver(). -finalize_exported_types(Set, CS) -> - ExportedTypes = ets_read_concurrent_table(dialyzer_codeserver_exported_types), +finalize_exported_types(Set, + #codeserver{exported_types = ExportedTypes, + temp_exported_types = TempETypes} = CS) -> true = ets_set_insert_set(Set, ExportedTypes), - TempExpTypes = CS#codeserver.temp_exported_types, - true = ets:delete(TempExpTypes), - CS#codeserver{exported_types = ExportedTypes, temp_exported_types = clean}. + true = ets:delete(TempETypes), + CS#codeserver{temp_exported_types = clean}. -spec lookup_mod_code(atom(), codeserver()) -> cerl:c_module(). @@ -237,6 +253,11 @@ lookup_mod_code(Mod, CS) when is_atom(Mod) -> lookup_mfa_code({_M, _F, _A} = MFA, CS) -> table__lookup(CS#codeserver.code, MFA). +-spec lookup_mfa_var_label(mfa(), codeserver()) -> {cerl:c_var(), label()}. + +lookup_mfa_var_label({_M, _F, _A} = MFA, CS) -> + ets:lookup_element(CS#codeserver.code, MFA, 3). + -spec get_next_core_label(codeserver()) -> label(). get_next_core_label(#codeserver{next_core_label = NCL}) -> @@ -251,8 +272,8 @@ set_next_core_label(NCL, CS) -> lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) -> case ets_dict_find(Mod, RecDict) of - error -> dict:new(); - {ok, Dict} -> Dict + error -> maps:new(); + {ok, Map} -> Map end. -spec get_records(codeserver()) -> mod_records(). @@ -262,11 +283,11 @@ get_records(#codeserver{records = RecDict}) -> -spec store_temp_records(module(), types(), codeserver()) -> codeserver(). -store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS) +store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS) when is_atom(Mod) -> - case dict:size(Dict) =:= 0 of + case maps:size(Map) =:= 0 of true -> CS; - false -> CS#codeserver{temp_records = ets_dict_store(Mod, Dict, TempRecDict)} + false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)} end. -spec get_temp_records(codeserver()) -> mod_records(). @@ -284,20 +305,20 @@ set_temp_records(Dict, CS) -> -spec finalize_records(mod_records(), codeserver()) -> codeserver(). -finalize_records(Dict, CS) -> - true = ets:delete(CS#codeserver.temp_records), - Records = ets_read_concurrent_table(dialyzer_codeserver_records), +finalize_records(Dict, #codeserver{temp_records = TmpRecords, + records = Records} = CS) -> + true = ets:delete(TmpRecords), true = ets_dict_store_dict(Dict, Records), - CS#codeserver{records = Records, temp_records = clean}. + CS#codeserver{temp_records = clean}. -spec lookup_mod_contracts(atom(), codeserver()) -> contracts(). lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) when is_atom(Mod) -> case ets_dict_find(Mod, ContDict) of - error -> dict:new(); + error -> maps:new(); {ok, Keys} -> - dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) + maps:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) end. get_file_contract(Key, ContDict) -> @@ -330,48 +351,69 @@ get_callbacks(#codeserver{callbacks = CallbDict}) -> -spec store_temp_contracts(module(), contracts(), contracts(), codeserver()) -> codeserver(). -store_temp_contracts(Mod, SpecDict, CallbackDict, +store_temp_contracts(Mod, SpecMap, CallbackMap, #codeserver{temp_contracts = Cn, temp_callbacks = Cb} = CS) when is_atom(Mod) -> - CS1 = - case dict:size(SpecDict) =:= 0 of - true -> CS; - false -> - CS#codeserver{temp_contracts = ets_dict_store(Mod, SpecDict, Cn)} - end, - case dict:size(CallbackDict) =:= 0 of - true -> CS1; - false -> - CS1#codeserver{temp_callbacks = ets_dict_store(Mod, CallbackDict, Cb)} - end. - --spec get_temp_contracts(codeserver()) -> {mod_contracts(), mod_contracts()}. + CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)}, + CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}. -get_temp_contracts(#codeserver{temp_contracts = TempContDict, - temp_callbacks = TempCallDict}) -> - {ets_dict_to_dict(TempContDict), ets_dict_to_dict(TempCallDict)}. +-spec contracts_modules(codeserver()) -> [module()]. --spec finalize_contracts(mod_contracts(), mod_contracts(), codeserver()) -> - codeserver(). +contracts_modules(#codeserver{temp_contracts = TempContTable}) -> + ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]). -finalize_contracts(SpecDict, CallbackDict, CS) -> - Contracts = ets_read_concurrent_table(dialyzer_codeserver_contracts), - Callbacks = ets_read_concurrent_table(dialyzer_codeserver_callbacks), - Contracts = dict:fold(fun decompose_spec_dict/3, Contracts, SpecDict), - Callbacks = dict:fold(fun decompose_cb_dict/3, Callbacks, CallbackDict), - CS#codeserver{contracts = Contracts, callbacks = Callbacks, - temp_contracts = clean, temp_callbacks = clean}. +-spec store_contracts(module(), contracts(), contracts(), codeserver()) -> + codeserver(). -decompose_spec_dict(Mod, Dict, Table) -> - Keys = dict:fetch_keys(Dict), - true = ets:insert(Table, dict:to_list(Dict)), - true = ets:insert(Table, {Mod, Keys}), - Table. +store_contracts(Mod, SpecMap, CallbackMap, CS) -> + #codeserver{contracts = SpecDict, callbacks = CallbackDict} = CS, + Keys = maps:keys(SpecMap), + true = ets:insert(SpecDict, maps:to_list(SpecMap)), + true = ets:insert(SpecDict, {Mod, Keys}), + true = ets:insert(CallbackDict, maps:to_list(CallbackMap)), + CS. -decompose_cb_dict(_Mod, Dict, Table) -> - true = ets:insert(Table, dict:to_list(Dict)), - Table. +-spec get_temp_contracts(module(), codeserver()) -> + {contracts(), contracts()}. + +get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict}) -> + [{Mod, Contracts}] = ets:lookup(TempContDict, Mod), + true = ets:delete(TempContDict, Mod), + [{Mod, Callbacks}] = ets:lookup(TempCallDict, Mod), + true = ets:delete(TempCallDict, Mod), + {Contracts, Callbacks}. + +-spec give_away(codeserver(), pid()) -> 'ok'. + +give_away(#codeserver{temp_records = TempRecords, + temp_contracts = TempContracts, + temp_callbacks = TempCallbacks, + records = Records, + contracts = Contracts, + callbacks = Callbacks}, Pid) -> + _ = [true = ets:give_away(Table, Pid, any) || + Table <- [TempRecords, TempContracts, TempCallbacks, + Records, Contracts, Callbacks], + Table =/= clean], + ok. + +-spec finalize_contracts(codeserver()) -> codeserver(). + +finalize_contracts(#codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict} = CS) -> + true = ets:delete(TempContDict), + true = ets:delete(TempCallDict), + CS#codeserver{temp_contracts = clean, temp_callbacks = clean}. + +-spec translate_fake_file(codeserver(), module(), file:filename()) -> + file:filename(). + +translate_fake_file(#codeserver{code = Code}, Module, FakeFile) -> + Files = ets:lookup_element(Code, {mod, Module}, 2), + {FakeFile, File} = lists:keyfind(FakeFile, 1, Files), + File. table__lookup(TablePid, M) when is_atom(M) -> {Name, Exports, Attrs, Keys, As} = ets:lookup_element(TablePid, M, 2), @@ -379,3 +421,25 @@ table__lookup(TablePid, M) when is_atom(M) -> cerl:ann_c_module(As, Name, Exports, Attrs, Defs); table__lookup(TablePid, MFA) -> ets:lookup_element(TablePid, MFA, 2). + +compress_file_anno(Term) -> + {Files, SmallTerm} = compress_file_anno(Term, []), + {[{FakeFile, File} || {File, {file, FakeFile}} <- Files], SmallTerm}. + +compress_file_anno({file, F}, Fs) when is_list(F) -> + case lists:keyfind(F, 1, Fs) of + false -> + I = integer_to_list(length(Fs)), + FileI = {file, I}, + NFs = [{F, FileI}|Fs], + {NFs, FileI}; + {F, FileI} -> {Fs, FileI} + end; +compress_file_anno(T, Fs) when is_tuple(T) -> + {NFs, NL} = compress_file_anno(tuple_to_list(T), Fs), + {NFs, list_to_tuple(NL)}; +compress_file_anno([E|L], Fs) -> + {Fs1, NE} = compress_file_anno(E, Fs), + {NFs, NL} = compress_file_anno(L, Fs1), + {NFs, [NE|NL]}; +compress_file_anno(T, Fs) -> {Fs, T}. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 73b04b305b..f3fba68e84 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -31,7 +31,7 @@ get_contract_return/2, %% get_contract_signature/1, is_overloaded/1, - process_contract_remote_types/1, + process_contract_remote_types/2, store_tmp_contract/5]). -export_type([file_contract/0, plt_contracts/0]). @@ -146,14 +146,13 @@ sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). --spec process_contract_remote_types(dialyzer_codeserver:codeserver()) -> - dialyzer_codeserver:codeserver(). +-spec process_contract_remote_types(dialyzer_codeserver:codeserver(), + erl_types:mod_records()) -> + dialyzer_codeserver:codeserver(). -process_contract_remote_types(CodeServer) -> - {TmpContractDict, TmpCallbackDict} = - dialyzer_codeserver:get_temp_contracts(CodeServer), +process_contract_remote_types(CodeServer, RecordDict) -> + Mods = dialyzer_codeserver:contracts_modules(CodeServer), ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), - RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) -> #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract, @@ -165,20 +164,21 @@ process_contract_remote_types(CodeServer) -> {{MFA, {File, Contract, Xtra}}, C2} end, ModuleFun = - fun({ModuleName, ContractDict}, C3) -> - {NewContractList, C4} = - lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)), - {{ModuleName, dict:from_list(NewContractList)}, C4} + fun(ModuleName) -> + Cache = erl_types:cache__new(), + {ContractMap, CallbackMap} = + dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer), + {NewContractList, Cache1} = + lists:mapfoldl(ContractFun, Cache, maps:to_list(ContractMap)), + {NewCallbackList, _NewCache} = + lists:mapfoldl(ContractFun, Cache1, maps:to_list(CallbackMap)), + dialyzer_codeserver:store_contracts(ModuleName, + maps:from_list(NewContractList), + maps:from_list(NewCallbackList), + CodeServer) end, - Cache = erl_types:cache__new(), - {NewContractList, C5} = - lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)), - {NewCallbackList, _C6} = - lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)), - NewContractDict = dict:from_list(NewContractList), - NewCallbackDict = dict:from_list(NewCallbackList), - dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, - CodeServer). + lists:foreach(ModuleFun, Mods), + dialyzer_codeserver:finalize_contracts(CodeServer). -type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). @@ -397,7 +397,7 @@ solve_constraints(Contract, Call, Constraints) -> %% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]), %% erl_types:t_assign_variables_to_subtype(Contract, Inf). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: dialyzer_codeserver:contracts(). %% Checks the contracts for functions that are not implemented -spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) -> @@ -407,12 +407,12 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity} || {Label, Arity} <- AllFuns0], AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1], - AllContractMFAs = dict:fetch_keys(Contracts), + AllContractMFAs = maps:keys(Contracts), ErrorContractMFAs = AllContractMFAs -- AllFuns2, [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts), + {{File, Line}, _Contract, _Xtra} = maps:get(MFA, Contracts), WarningInfo = {File, Line, MFA}, {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. @@ -445,11 +445,11 @@ insert_constraints([], Map) -> Map. -spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) -> contracts(). -store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> +store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), - dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). + maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap). contract_from_form(Forms, MFA, RecDict, FileLine) -> {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []), @@ -677,7 +677,7 @@ get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) -> get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) -> Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer), - Contracts2 = dict:to_list(Contracts1), + Contracts2 = maps:to_list(Contracts1), Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc), get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc); diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 639ed426df..83ce875280 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -529,7 +529,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], case is_race_analysis_enabled(State) of true -> Ann = cerl:get_ann(Tree), - File = get_file(Ann), + File = get_file(Ann, State), Line = abs(get_line(Ann)), dialyzer_races:store_race_call(Fun, ArgTypes, Args, {File, Line}, State); @@ -1351,8 +1351,6 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) -> {Msg, Force} = case t_is_none(ArgType0) of true -> - PatString = format_patterns(Pats), - PatTypes = [PatString, format_type(OrigArgType, State1)], %% See if this is covered by an earlier clause or if it %% simply cannot match OrigArgTypes = @@ -1360,14 +1358,24 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) -> true -> Any = t_any(), [Any || _ <- Pats]; false -> t_to_tlist(OrigArgType) end, + PatString = format_patterns(Pats), + ArgTypeString = format_type(OrigArgType, State1), + BindResOrig = + bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1), Tag = - case bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1) of + case BindResOrig of {error, bind, _, _, _} -> pattern_match; {error, record, _, _, _} -> record_match; {error, opaque, _, _, _} -> opaque_match; {_, _} -> pattern_match_cov end, - {{Tag, PatTypes}, false}; + PatTypes = case BindResOrig of + {error, opaque, _, _, OpaqueType} -> + [PatString, ArgTypeString, + format_type(OpaqueType, State1)]; + _ -> [PatString, ArgTypeString] + end, + {{Tag, PatTypes}, false}; false -> %% Try to find out if this is a default clause in a list %% comprehension and supress this. A real Hack(tm) @@ -3090,7 +3098,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, Ann = cerl:get_ann(Tree), case Force of true -> - WarningInfo = {get_file(Ann), + WarningInfo = {get_file(Ann, State), abs(get_line(Ann)), State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, @@ -3100,7 +3108,9 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, case is_compiler_generated(Ann) of true -> State; false -> - WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun}, + WarningInfo = {get_file(Ann, State), + get_line(Ann), + State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, case Tag of ?WARN_CONTRACT_RANGE -> ok; @@ -3499,6 +3509,12 @@ state__put_races(Races, State) -> state__records_only(#state{records = Records}) -> #state{records = Records}. +-spec state__translate_file(file:filename(), state()) -> file:filename(). + +state__translate_file(FakeFile, State) -> + #state{codeserver = CodeServer, module = Module} = State, + dialyzer_codeserver:translate_fake_file(CodeServer, Module, FakeFile). + %%% =========================================================================== %%% %%% Races @@ -3570,9 +3586,11 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([]) -> []; -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file([], _State) -> []; +get_file([{file, FakeFile}|_], State) -> + state__translate_file(FakeFile, State); +get_file([_|Tail], State) -> + get_file(Tail, State). is_compiler_generated(Ann) -> lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1). diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 4caf64d007..1701aff2f2 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -505,8 +505,9 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, end, ExplanationPid = spawn_link(Fun), gui_loop(State#gui_state{expl_pid = ExplanationPid}); - {BackendPid, done, _NewPlt, NewDocPlt} -> + {BackendPid, done, NewMiniPlt, NewDocPlt} -> message(State, "Analysis done"), + dialyzer_plt:delete(NewMiniPlt), config_gui_stop(State), gui_loop(State#gui_state{doc_plt = NewDocPlt}); {'EXIT', BackendPid, {error, Reason}} -> diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index cf2f0e919e..5ababa43dc 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -58,7 +58,9 @@ get_specs/4, to_file/4, get_mini_plt/1, - restore_full_plt/2 + restore_full_plt/1, + delete/1, + give_away/2 ]). %% Debug utilities @@ -82,14 +84,16 @@ %%---------------------------------------------------------------------- -record(plt, {info = table_new() :: dict:dict(), - types = table_new() :: dict:dict(), + types = table_new() :: erl_types:mod_records(), contracts = table_new() :: dict:dict(), callbacks = table_new() :: dict:dict(), exported_types = sets:new() :: sets:set()}). -record(mini_plt, {info :: ets:tid(), + types :: ets:tid(), contracts :: ets:tid(), - callbacks :: ets:tid() + callbacks :: ets:tid(), + exported_types :: ets:tid() }). -opaque plt() :: #plt{} | #mini_plt{}. @@ -130,6 +134,10 @@ delete_module(#plt{info = Info, types = Types, -spec delete_list(plt(), [mfa() | integer()]) -> plt(). +delete_list(#mini_plt{info = Info, + contracts = Contracts}=Plt, List) -> + Plt#mini_plt{info = ets_table_delete_list(Info, List), + contracts = ets_table_delete_list(Contracts, List)}; delete_list(#plt{info = Info, types = Types, contracts = Contracts, callbacks = Callbacks, @@ -183,7 +191,7 @@ lookup(Plt, Label) when is_integer(Label) -> lookup_1(#mini_plt{info = Info}, MFAorLabel) -> ets_table_lookup(Info, MFAorLabel). --spec insert_types(plt(), dict:dict()) -> plt(). +-spec insert_types(plt(), erl_types:mod_records()) -> plt(). insert_types(PLT, Rec) -> PLT#plt{types = Rec}. @@ -193,7 +201,7 @@ insert_types(PLT, Rec) -> insert_exported_types(PLT, Set) -> PLT#plt{exported_types = Set}. --spec get_types(plt()) -> dict:dict(). +-spec get_types(plt()) -> erl_types:mod_records(). get_types(#plt{types = Types}) -> Types. @@ -226,12 +234,8 @@ contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) -> get_default_plt() -> case os:getenv("DIALYZER_PLT") of false -> - case os:getenv("HOME") of - false -> - plt_error("The HOME environment variable needs to be set " ++ - "so that Dialyzer knows where to find the default PLT"); - HomeDir -> filename:join(HomeDir, ".dialyzer_plt") - end; + {ok,[[HomeDir]]} = init:get_argument(home), + filename:join(HomeDir, ".dialyzer_plt"); UserSpecPlt -> UserSpecPlt end. @@ -253,8 +257,10 @@ from_file(FileName, ReturnInfo) -> Msg = io_lib:format("Old PLT file ~s\n", [FileName]), plt_error(Msg); ok -> + Types = [{Mod, maps:from_list(dict:to_list(Types))} || + {Mod, Types} <- dict:to_list(Rec#file_plt.types)], Plt = #plt{info = Rec#file_plt.info, - types = Rec#file_plt.types, + types = dict:from_list(Types), contracts = Rec#file_plt.contracts, callbacks = Rec#file_plt.callbacks, exported_types = Rec#file_plt.exported_types}, @@ -371,12 +377,14 @@ to_file(FileName, end, OldModDeps, ModDeps), ImplMd5 = compute_implementation_md5(), + FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} || + {Mod, MTypes} <- dict:to_list(Types)]), Record = #file_plt{version = ?VSN, file_md5_list = MD5, info = Info, contracts = Contracts, callbacks = Callbacks, - types = Types, + types = FileTypes, exported_types = ExpTypes, mod_deps = NewModDeps, implementation_md5 = ImplMd5}, @@ -510,32 +518,100 @@ init_md5_list_1(Md5List, [], Acc) -> -spec get_mini_plt(plt()) -> plt(). -get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks}) -> - [ETSInfo, ETSContracts, ETSCallbacks] = - [ets:new(Name, [public]) || Name <- [plt_info, plt_contracts, plt_callbacks]], +get_mini_plt(#plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}) -> + [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] = + [ets:new(Name, [public]) || + Name <- [plt_info, plt_types, plt_contracts, plt_callbacks, + plt_exported_types]], CallbackList = dict:to_list(Callbacks), CallbacksByModule = [{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} || M <- lists:usort([M || {{M,_,_},_} <- CallbackList])], - [true, true] = + [true, true, true] = [ets:insert(ETS, dict:to_list(Data)) || - {ETS, Data} <- [{ETSInfo, Info}, {ETSContracts, Contracts}]], + {ETS, Data} <- [{ETSInfo, Info}, + {ETSTypes, Types}, + {ETSContracts, Contracts}]], true = ets:insert(ETSCallbacks, CallbacksByModule), - #mini_plt{info = ETSInfo, contracts = ETSContracts, callbacks = ETSCallbacks}; + true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]), + #mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}; get_mini_plt(undefined) -> undefined. --spec restore_full_plt(plt(), plt()) -> plt(). - -restore_full_plt(#mini_plt{info = ETSInfo, contracts = ETSContracts}, Plt) -> - Info = dict:from_list(ets:tab2list(ETSInfo)), - Contracts = dict:from_list(ets:tab2list(ETSContracts)), - ets:delete(ETSContracts), - ets:delete(ETSInfo), - Plt#plt{info = Info, contracts = Contracts}; -restore_full_plt(undefined, undefined) -> +-spec restore_full_plt(plt()) -> plt(). + +restore_full_plt(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes} = MiniPlt) -> + Info = dict:from_list(tab2list(ETSInfo)), + Contracts = dict:from_list(tab2list(ETSContracts)), + Types = dict:from_list(tab2list(ETSTypes)), + Callbacks = + dict:from_list([Cb || {_M, Cbs} <- tab2list(ETSCallbacks), Cb <- Cbs]), + ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]), + ok = delete(MiniPlt), + #plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}; +restore_full_plt(undefined) -> undefined. +-spec delete(plt()) -> 'ok'. + +delete(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}) -> + true = ets:delete(ETSContracts), + true = ets:delete(ETSTypes), + true = ets:delete(ETSInfo), + true = ets:delete(ETSCallbacks), + true = ets:delete(ETSExpTypes), + ok. + +-spec give_away(plt(), pid()) -> 'ok'. + +give_away(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}, + Pid) -> + true = ets:give_away(ETSContracts, Pid, any), + true = ets:give_away(ETSTypes, Pid, any), + true = ets:give_away(ETSInfo, Pid, any), + true = ets:give_away(ETSCallbacks, Pid, any), + true = ets:give_away(ETSExpTypes, Pid, any), + ok. + +%% Somewhat slower than ets:tab2list(), but uses less memory. +tab2list(T) -> + tab2list(ets:first(T), T, []). + +tab2list('$end_of_table', T, A) -> + case ets:first(T) of % no safe_fixtable()... + '$end_of_table' -> A; + Key -> tab2list(Key, T, A) + end; +tab2list(Key, T, A) -> + Vs = ets:lookup(T, Key), + Key1 = ets:next(T, Key), + ets:delete(T, Key), + tab2list(Key1, T, Vs ++ A). + %%--------------------------------------------------------------------------- %% Edoc @@ -607,6 +683,12 @@ table_delete_module1(Plt, Mod) -> table_delete_module2(Plt, Mod) -> dict:filter(fun(M, _Val) -> M =/= Mod end, Plt). +ets_table_delete_list(Tab, [H|T]) -> + ets:delete(Tab, H), + ets_table_delete_list(Tab, T); +ets_table_delete_list(Tab, []) -> + Tab. + table_delete_list(Plt, [H|T]) -> table_delete_list(dict:erase(H, Plt), T); table_delete_list(Plt, []) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 987da3aecf..0e44a5223f 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -96,7 +96,7 @@ analyze_callgraph(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent) -> NewState = init_state_and_get_success_typings(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent), - dialyzer_plt:restore_full_plt(NewState#st.plt, Plt). + NewState#st.plt. %%-------------------------------------------------------------------- @@ -111,6 +111,7 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver, get_refined_success_typings(SCCs, #st{callgraph = Callgraph, timing_server = TimingServer} = State) -> + erlang:garbage_collect(), case find_succ_typings(SCCs, State) of {fixpoint, State1} -> State1; {not_fixpoint, NotFixpoint1, State1} -> @@ -155,8 +156,8 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver, ?timing(TimingServer, "warning", get_warnings_from_modules(Mods, InitState, MiniDocPlt)), {postprocess_warnings(CWarns ++ ModWarns, Codeserver), - dialyzer_plt:restore_full_plt(MiniPlt, Plt), - dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}. + MiniPlt, + dialyzer_plt:restore_full_plt(MiniDocPlt)}. get_warnings_from_modules(Mods, State, DocPlt) -> #st{callgraph = Callgraph, codeserver = Codeserver, @@ -174,10 +175,10 @@ collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) -> %% Check if there are contracts for functions that do not exist Warnings1 = dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph), + Attrs = cerl:module_attrs(ModCode), {Warnings2, FunTypes} = dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver, Records), - Attrs = cerl:module_attrs(ModCode), Warnings3 = dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver), DocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt), @@ -262,7 +263,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> NewFunTypes = dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records), Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer), - Contracts = orddict:from_list(dict:to_list(Contracts1)), + Contracts = orddict:from_list(maps:to_list(Contracts1)), FindOpaques = find_opaques_fun(Records), DecoratedFunTypes = decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques), @@ -348,21 +349,25 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph, -spec find_succ_types_for_scc(scc(), typesig_init_data()) -> [mfa_or_funlbl()]. -find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) -> - SCC_Info = [{MFA, - dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - dialyzer_codeserver:lookup_mod_records(M, Codeserver)} - || {M, _, _} = MFA <- SCC], +find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) -> + SCC = [MFA || {_, _, _} = MFA <- SCC0], Contracts1 = [{MFA, dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver)} - || {_, _, _} = MFA <- SCC], + || MFA <- SCC], Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1], Contracts3 = orddict:from_list(Contracts2), Label = dialyzer_codeserver:get_next_core_label(Codeserver), - AllFuns = collect_fun_info([Fun || {_MFA, {_Var, Fun}, _Rec} <- SCC_Info]), + AllFuns = lists:append( + [begin + {_Var, Fun} = + dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + collect_fun_info([Fun]) + end || MFA <- SCC]), + erlang:garbage_collect(), PropTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt), %% Assume that the PLT contains the current propagated types - FunTypes = dialyzer_typesig:analyze_scc(SCC_Info, Label, Callgraph, - Plt, PropTypes, Solvers), + FunTypes = dialyzer_typesig:analyze_scc(SCC, Label, Callgraph, + Codeserver, Plt, PropTypes, + Solvers), AllFunSet = sets:from_list([X || {X, _} <- AllFuns]), FilteredFunTypes = dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 1787b66192..4d650592e2 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,7 +29,7 @@ -module(dialyzer_typesig). --export([analyze_scc/6]). +-export([analyze_scc/7]). -export([get_safe_underapprox/2]). %%-import(helper, %% 'helper' could be any module doing sanity checks... @@ -101,10 +101,9 @@ -type types() :: erl_types:type_table(). --type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}]. -type typesig_funmap() :: #{type_var() => type_var()}. --type prop_types() :: dict:dict(label(), types()). +-type prop_types() :: dict:dict(label(), erl_types:erl_type()). -record(state, {callgraph :: dialyzer_callgraph:callgraph() | 'undefined', @@ -121,7 +120,7 @@ plt :: dialyzer_plt:plt() | 'undefined', prop_types = dict:new() :: prop_types(), - records = dict:new() :: types(), + records = maps:new() :: types(), scc = [] :: ordsets:ordset(type_var()), mfas :: [mfa()], solvers = [] :: [solver()] @@ -160,11 +159,10 @@ %%----------------------------------------------------------------------------- %% Analysis of strongly connected components. %% -%% analyze_scc(SCC, NextLabel, CallGraph, PLT, PropTypes, Solvers) -> FunTypes +%% analyze_scc(SCC, NextLabel, CallGraph, CodeServer, +%% PLT, PropTypes, Solvers) -> FunTypes %% -%% SCC - [{MFA, Def, Records}] -%% where Def = {Var, Fun} as in the Core Erlang module definitions. -%% Records = dict(RecName, {Arity, [{FieldName, FieldType}]}) +%% SCC - [{MFA}] %% NextLabel - An integer that is higher than any label in the code. %% CallGraph - A callgraph as produced by dialyzer_callgraph.erl %% Note: The callgraph must have been built with all the @@ -176,28 +174,27 @@ %% Solvers - User specified solvers. %%----------------------------------------------------------------------------- --spec analyze_scc(typesig_scc(), label(), +-spec analyze_scc([mfa()], label(), dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver(), dialyzer_plt:plt(), prop_types(), [solver()]) -> prop_types(). -analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) -> +analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) -> Solvers = solvers(Solvers0), - assert_format_of_scc(SCC), - State1 = new_state(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers), - DefSet = add_def_list([Var || {_MFA, {Var, _Fun}, _Rec} <- SCC], sets:new()), - State2 = traverse_scc(SCC, DefSet, State1), + State1 = new_state(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, + Solvers), + DefSet = add_def_list(maps:values(State1#state.name_map), sets:new()), + ModRecs = [{M, dialyzer_codeserver:lookup_mod_records(M, CServer)} || + M <- lists:usort([M || {M, _, _} <- SCC])], + State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1), State3 = state__finalize(State2), + erlang:garbage_collect(), Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), T = solve(Funs, State3), dict:from_list(maps:to_list(T)). -assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) -> - assert_format_of_scc(Left); -assert_format_of_scc([]) -> - ok. - solvers([]) -> [v2]; solvers(Solvers) -> Solvers. @@ -207,12 +204,15 @@ solvers(Solvers) -> Solvers. %% %% ============================================================================ -traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) -> +traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) -> + Def = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + {M, Rec} = lists:keyfind(M, 1, ModRecs), TmpState1 = state__set_rec_dict(AccState, Rec), DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)), - {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1), - traverse_scc(Left, DefSet, NewAccState); -traverse_scc([], _DefSet, AccState) -> + TmpState2 = state__new_constraint_context(TmpState1), + {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2), + traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState); +traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) -> AccState. traverse(Tree, DefinedVars, State) -> @@ -2106,6 +2106,12 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval, end; v2_solve_disj([], [], _I, _Map, V2State, UL, MapL, Eval, Uneval, Failed) -> {ok, V2State, lists:reverse(Eval), UL, MapL, lists:reverse(Uneval), Failed}; +v2_solve_disj([every_i], Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) -> + NewIs = case Cs of + [] -> []; + _ -> [I, every_i] + end, + v2_solve_disj(NewIs, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed); v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) -> Uneval = [{I,C#constraint_list.id} || not is_failed_list(C, V2State)] ++ Uneval0, @@ -2177,7 +2183,7 @@ v2_solve_conj([I|Is], [Cs|Tail], I, Map0, Conj, IsFlat, V2State0, M = lists:keydelete(I, 1, vars_per_child(U, Masks)), {V2State2, NewF0} = save_updated_vars_list(AllCs, M, V2State1), {NewF, F} = lists:splitwith(fun(J) -> J < I end, NewF0), - Is1 = lists:umerge(Is, F), + Is1 = umerge_mask(Is, F), NewFs = [NewF|NewFs0], v2_solve_conj(Is1, Tail, I+1, Map, Conj, IsFlat, V2State2, [U|UL], NewFs, VarsUp, LastMap, LastFlags) @@ -2199,6 +2205,14 @@ v2_solve_conj([], _Cs, _I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, v2_solve_conj(NewFlags, Cs, 1, Map, Conj, IsFlat, V2State, [], [], [U|VarsUp], Map, NewFlags) end; +v2_solve_conj([every_i], Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, + LastMap, LastFlags) -> + NewIs = case Cs of + [] -> []; + _ -> [I, every_i] + end, + v2_solve_conj(NewIs, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, + LastMap, LastFlags); v2_solve_conj(Is, [_|Tail], I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, LastMap, LastFlags) -> v2_solve_conj(Is, Tail, I+1, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, @@ -2215,7 +2229,12 @@ report_detected_loop(_) -> add_mask_to_flags(Flags, [Im|M], I, L) when I > Im -> add_mask_to_flags(Flags, M, I, [Im|L]); add_mask_to_flags(Flags, [_|M], _I, L) -> - {lists:umerge(M, Flags), lists:reverse(L)}. + {umerge_mask(Flags, M), lists:reverse(L)}. + +umerge_mask([every_i]=Is, _F) -> + Is; +umerge_mask(Is, F) -> + lists:umerge(Is, F). get_mask(V, Masks) -> case maps:find(V, Masks) of @@ -2229,7 +2248,7 @@ get_flags(#v2_state{constr_data = ConData}=V2State0, C) -> error -> ?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]), V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)}, - {V2State, lists:seq(1, length(Cs))}; + {V2State, [every_i]}; {ok, failed} -> {V2State0, failed_list}; {ok, {Part,U}} when U =/= [] -> @@ -2702,11 +2721,14 @@ pp_map(_S, _Map) -> %% %% ============================================================================ -new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> - List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0], +new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) -> + List_SCC = + [begin + {Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer), + {{MFA, Var}, t_var(Label)} + end || MFA <- MFAs], + {List, SCC} = lists:unzip(List_SCC), NameMap = maps:from_list(List), - MFAs = [MFA || {MFA, _Var} <- List], - SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0], SelfRec = case SCC of [OneF] -> @@ -2906,8 +2928,9 @@ state__get_rec_var(Fun, #state{fun_map = Map}) -> maps:find(Fun, Map). state__finalize(State) -> - State1 = enumerate_constraints(State), - order_fun_constraints(State1). + State1 = state__new_constraint_context(State), + State2 = enumerate_constraints(State1), + order_fun_constraints(State2). %% ============================================================================ %% @@ -2987,7 +3010,7 @@ find_constraint_deps([Type|Tail], Acc) -> NewAcc = [[t_var_name(D) || D <- t_collect_vars(Type)]|Acc], find_constraint_deps(Tail, NewAcc); find_constraint_deps([], Acc) -> - lists:flatten(Acc). + lists:append(Acc). mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs -> #constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps}; @@ -3095,8 +3118,8 @@ expand_to_conjunctions(#constraint_list{type = disj, list = List}) -> List1 = [C || C <- List, is_simple_constraint(C)], %% Just an assert. [] = [C || #constraint{} = C <- List1], - Expanded = lists:flatten([expand_to_conjunctions(C) - || #constraint_list{} = C <- List]), + Expanded = lists:append([expand_to_conjunctions(C) + || #constraint_list{} = C <- List]), ReturnList = Expanded ++ List1, if length(ReturnList) > ?DISJ_NORM_FORM_LIMIT -> throw(too_many_disj); true -> ReturnList @@ -3121,8 +3144,10 @@ calculate_deps(List) -> calculate_deps([H|Tail], Acc) -> Deps = get_deps(H), calculate_deps(Tail, [Deps|Acc]); +calculate_deps([], []) -> []; +calculate_deps([], [L]) -> L; calculate_deps([], Acc) -> - ordsets:from_list(lists:flatten(Acc)). + lists:umerge(Acc). mk_conj_constraint_list(List) -> mk_constraint_list(conj, List). diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 1f2d3e3aaa..e71a953279 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -202,7 +202,7 @@ get_core_from_abstract_code(AbstrCode, Opts) -> get_record_and_type_info(AbstractCode) -> Module = get_module(AbstractCode), - get_record_and_type_info(AbstractCode, Module, dict:new()). + get_record_and_type_info(AbstractCode, Module, maps:new()). -spec get_record_and_type_info(abstract_code(), module(), type_table()) -> {'ok', type_table()} | {'error', string()}. @@ -215,7 +215,7 @@ get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left], {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity,Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} |Left], Module, RecDict, File) -> @@ -223,7 +223,7 @@ get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity, Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left], Module, RecDict, File) @@ -263,9 +263,9 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN, false -> try erl_types:t_var_names(ArgForms) of ArgNames -> - dict:store({TypeOrOpaque, Name, Arity}, - {{Module, FN, TypeForm, ArgNames}, - erl_types:t_any()}, RecDict) + maps:put({TypeOrOpaque, Name, Arity}, + {{Module, FN, TypeForm, ArgNames}, + erl_types:t_any()}, RecDict) catch _:_ -> throw({error, flat_format("Type declaration for ~w does not " @@ -296,19 +296,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> get_record_fields([], _RecDict, Acc) -> lists:reverse(Acc). --spec process_record_remote_types(codeserver()) -> codeserver(). +-spec process_record_remote_types(codeserver()) -> + {codeserver(), mod_records()}. %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), ExpTypes = dialyzer_codeserver:get_exported_types(CServer), - Cache = erl_types:cache__new(), - {TempRecords1, Cache1} = - process_opaque_types0(TempRecords, ExpTypes, Cache), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), %% A cache (not the field type cache) is used for speeding things up a bit. VarTable = erl_types:var_table__new(), ModuleFun = - fun({Module, Record}, C0) -> + fun({Module, Record}) -> RecordFun = fun({Key, Value}, C2) -> case Key of @@ -334,24 +333,27 @@ process_record_remote_types(CServer) -> _Other -> {{Key, Value}, C2} end end, - {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + Cache = erl_types:cache__new(), + {RecordList, _NewCache} = + lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)), + {Module, maps:from_list(RecordList)} end, - {NewRecordsList, C1} = - lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)), + NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)), NewRecords = dict:from_list(NewRecordsList), - _C8 = check_record_fields(NewRecords, ExpTypes, C1), - dialyzer_codeserver:finalize_records(NewRecords, CServer). + check_record_fields(NewRecords, ExpTypes), + {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}. %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, %% any(), is not used, the expansion is done twice. %% XXX: Recursive opaque types are not handled well. -process_opaque_types0(TempRecords0, TempExpTypes, Cache) -> - {TempRecords1, NewCache} = +process_opaque_types0(TempRecords0, TempExpTypes) -> + Cache = erl_types:cache__new(), + {TempRecords1, Cache1} = process_opaque_types(TempRecords0, TempExpTypes, Cache), - process_opaque_types(TempRecords1, TempExpTypes, NewCache). + {TempRecords, _NewCache} = + process_opaque_types(TempRecords1, TempExpTypes, Cache1), + TempRecords. process_opaque_types(TempRecords, TempExpTypes, Cache) -> VarTable = erl_types:var_table__new(), @@ -371,8 +373,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> end end, {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + lists:mapfoldl(RecordFun, C0, maps:to_list(Record)), + {{Module, maps:from_list(RecordList)}, C1} %% dict:map(RecordFun, Record) end, {TempRecordList, NewCache} = @@ -380,7 +382,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> {dict:from_list(TempRecordList), NewCache}. %% dict:map(ModuleFun, TempRecords). -check_record_fields(Records, TempExpTypes, Cache) -> +check_record_fields(Records, TempExpTypes) -> + Cache = erl_types:cache__new(), VarTable = erl_types:var_table__new(), CheckFun = fun({Module, Element}, C0) -> @@ -410,9 +413,10 @@ check_record_fields(Records, TempExpTypes, Cache) -> msg_with_position(Fun, FileLine) end end, - lists:foldl(ElemFun, C0, dict:to_list(Element)) + lists:foldl(ElemFun, C0, maps:to_list(Element)) end, - lists:foldl(CheckFun, Cache, dict:to_list(Records)). + _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)), + ok. msg_with_position(Fun, FileLine) -> try Fun() @@ -435,17 +439,17 @@ merge_records(NewRecords, OldRecords) -> %% %% ============================================================================ --type spec_dict() :: dict:dict(). --type callback_dict() :: dict:dict(). +-type spec_map() :: dialyzer_codeserver:contracts(). +-type callback_map() :: dialyzer_codeserver:contracts(). -spec get_spec_info(module(), abstract_code(), type_table()) -> - {'ok', spec_dict(), callback_dict()} | {'error', string()}. + {'ok', spec_map(), callback_map()} | {'error', string()}. -get_spec_info(ModName, AbstractCode, RecordsDict) -> +get_spec_info(ModName, AbstractCode, RecordsMap) -> OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName), OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0), - get_spec_info(AbstractCode, dict:new(), dict:new(), - RecordsDict, ModName, OptionalCallbacks, "nofile"). + get_spec_info(AbstractCode, maps:new(), maps:new(), + RecordsMap, ModName, OptionalCallbacks, "nofile"). get_optional_callbacks(Abs, ModName) -> [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)]. @@ -463,7 +467,7 @@ get_optional_callbacks(Abs) -> %% are erl_types:erl_type() get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> Ln = erl_anno:line(Anno), @@ -472,24 +476,24 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], {F, A} -> {ModName, F, A} end, Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)], - ActiveDict = + ActiveMap = case Contract of - spec -> SpecDict; - callback -> CallbackDict + spec -> SpecMap; + callback -> CallbackMap end, - try dict:find(MFA, ActiveDict) of + try maps:find(MFA, ActiveMap) of error -> SpecData = {TypeSpec, Xtra}, - NewActiveDict = + NewActiveMap = dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData, - ActiveDict, RecordsDict), - {NewSpecDict, NewCallbackDict} = + ActiveMap, RecordsMap), + {NewSpecMap, NewCallbackMap} = case Contract of - spec -> {NewActiveDict, CallbackDict}; - callback -> {SpecDict, NewActiveDict} + spec -> {NewActiveMap, CallbackMap}; + callback -> {SpecMap, NewActiveMap} end, - get_spec_info(Left, NewSpecDict, NewCallbackDict, - RecordsDict, ModName, OptCb, File); + get_spec_info(Left, NewSpecMap, NewCallbackMap, + RecordsMap, ModName, OptCb, File); {ok, {{OtherFile, L}, _D}} -> {Mod, Fun, Arity} = MFA, Msg = flat_format(" Contract/callback for function ~w:~w/~w " @@ -502,16 +506,16 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], [Ln, Error])} end; get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, IncludeFile); -get_spec_info([_Other|Left], SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File); -get_spec_info([], SpecDict, CallbackDict, - _RecordsDict, _ModName, _OptCb, _File) -> - {ok, SpecDict, CallbackDict}. + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, _File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, IncludeFile); +get_spec_info([_Other|Left], SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File); +get_spec_info([], SpecMap, CallbackMap, + _RecordsMap, _ModName, _OptCb, _File) -> + {ok, SpecMap, CallbackMap}. -spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) -> dialyzer_codeserver:fun_meta_info() | {'error', string()}. @@ -707,7 +711,7 @@ format_errors([]) -> -spec format_sig(erl_types:erl_type()) -> string(). format_sig(Type) -> - format_sig(Type, dict:new()). + format_sig(Type, maps:new()). -spec format_sig(erl_types:erl_type(), type_table()) -> string(). @@ -959,9 +963,7 @@ label(Tree) -> -spec parallelism() -> integer(). parallelism() -> - CPUs = erlang:system_info(logical_processors_available), - Schedulers = erlang:system_info(schedulers), - min(CPUs, Schedulers). + erlang:system_info(schedulers_online). -spec family([{K,V}]) -> [{K,[V]}]. diff --git a/lib/dialyzer/test/abstract_SUITE.erl b/lib/dialyzer/test/abstract_SUITE.erl index 269db3e836..0e84dfab24 100644 --- a/lib/dialyzer/test/abstract_SUITE.erl +++ b/lib/dialyzer/test/abstract_SUITE.erl @@ -7,7 +7,7 @@ -include_lib("common_test/include/ct.hrl"). -include("dialyzer_test_constants.hrl"). --export([suite/0, all/0, init_per_suite/0, init_per_suite/1]). +-export([suite/0, all/0, init_per_suite/0, init_per_suite/1, end_per_suite/1]). -export([generated_case/1]). suite() -> @@ -24,6 +24,10 @@ init_per_suite(Config) -> ok -> [{dialyzer_options, []}|Config] end. +end_per_suite(_Config) -> + %% This function is required since init_per_suite/1 exists. + ok. + generated_case(Config) when is_list(Config) -> %% Equivalent to: %% diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options index cb6a88786e..365b4798c5 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, []}. -{time_limit, 2}. +{time_limit, 5}. diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options index 50991c9bc5..02425c33f2 100644 --- a/lib/dialyzer/test/map_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options @@ -1 +1,2 @@ {dialyzer_options, []}. +{time_limit, 30}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options index 06ed52043a..cb301ff6a1 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]}]}. -{time_limit, 20}. +{time_limit, 40}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/weird b/lib/dialyzer/test/opaque_SUITE_data/results/weird new file mode 100644 index 0000000000..d7f57cd152 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/weird @@ -0,0 +1,6 @@ + +weird_warning1.erl:15: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #b{q::queue:queue(_)} +weird_warning2.erl:13: Matching of pattern <{'b', Queue}, Key, Value> tagged with a record name violates the declared type of <#a{d::dict:dict(_,_)},'my_key','my_value'> +weird_warning3.erl:14: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') does not have a term of type #a{d::dict:dict(_,_)} | #b{q::queue:queue(_)} (with opaque subterms) as 1st argument +weird_warning3.erl:16: The attempt to match a term of type #a{d::queue:queue(_)} against the pattern {'a', Dict} breaks the opacity of queue:queue(_) +weird_warning3.erl:18: Matching of pattern {'b', Queue} tagged with a record name violates the declared type of #a{d::queue:queue(_)} diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl new file mode 100644 index 0000000000..094138e72b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl @@ -0,0 +1,18 @@ +-module(weird_warning1). +-export([public_func/0]). + +-record(a, { + d = dict:new() :: dict:dict() + }). + +-record(b, { + q = queue:new() :: queue:queue() + }). + +public_func() -> + add_element(#b{}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl new file mode 100644 index 0000000000..4e4512157b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl @@ -0,0 +1,14 @@ +-module(weird_warning2). +-export([public_func/0]). + +-record(a, {d = dict:new() :: dict:dict()}). + +-record(b, {q = queue:new() :: queue:queue()}). + +public_func() -> + add_element(#a{}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl new file mode 100644 index 0000000000..b70ca645cb --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl @@ -0,0 +1,19 @@ +-module(weird_warning3). +-export([public_func/0]). + +-record(a, { + d = dict:new() :: dict:dict() + }). + +-record(b, { + q = queue:new() :: queue:queue() + }). + +public_func() -> + %% Notice that t_to_string() will create "#a{d::queue:queue(_)}". + add_element({a, queue:new()}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index 460d4e2240..fbfa979e1b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -26,6 +26,8 @@ build_plt(Config) -> end. beam_tests(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "beam_tests.plt"), Prog = <<" -module(no_auto_import). @@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) -> ">>, Opts = [no_auto_import], {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer(plt_build, [BeamFile], []), + [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]), ok. run_plt_check(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_plt_check.plt"), Mod1 = <<" -module(run_plt_check1). ">>, @@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) -> {ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []), {ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []), - [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []), + [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]), Mod2B = <<" -module(run_plt_check2). @@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) -> % callgraph warning as run_plt_check2:call/1 makes a call to unexported % function run_plt_check1:call/1. - [_] = run_dialyzer(plt_check, [], []), + [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]), ok. run_succ_typings(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_succ_typings.plt"), Mod1A = <<" -module(run_succ_typings1). @@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) -> ">>, {ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []), - [] = run_dialyzer(plt_build, [BeamFile1], []), + [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]), Mod1B = <<" -module(run_succ_typings1). @@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) -> {ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []), % contract types warning as run_succ_typings2:call/0 makes a call to % run_succ_typings1:call/0, which returns a (not b) in the PLT. - [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]), + [_] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, false}, {init_plt, Plt}]), % warning not returned as run_succ_typings1 is updated in the PLT. - [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]), + [] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, true}, {init_plt, Plt}]), ok. @@ -252,12 +260,9 @@ remove_plt(Config) -> ok. bad_dialyzer_attr(Config) -> - PrivDir = ?config(priv_dir, Config), - Prog1 = <<"-module(dial). -dialyzer({no_return, [undef/0]}).">>, {ok, Beam1} = compile(Config, Prog1, dial, []), - Plt = filename:join(PrivDir, "bad_attr.plt"), {dialyzer_error, "Analysis failed with error:\n" "Could not scan the following file(s):\n" diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars new file mode 100644 index 0000000000..2c1f8f8d17 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -0,0 +1,4 @@ + +chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' +chars.erl:32: Function t1/0 has no local return +chars.erl:32: 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/src/anno.erl b/lib/dialyzer/test/small_SUITE_data/src/anno.erl new file mode 100644 index 0000000000..70f1d42141 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/anno.erl @@ -0,0 +1,18 @@ +-module(anno). + +%% OTP-14131 + +-export([t1/0, t2/0, t3/0]). + +t1() -> + A = erl_parse:anno_from_term({attribute, 1, module, my_test}), + compile:forms([A], []). + +t2() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + compile:forms([A], []). + +t3() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + T = erl_parse:anno_to_term(A), + {attribute, 1, module, my_test} = T. diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl new file mode 100644 index 0000000000..1e9c8ab6b9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl @@ -0,0 +1,32 @@ +-module(chars). + +%% ERL-313 + +-export([t/0]). +-export([t1/0]). + +-record(r, {f :: $A .. $Z}). + +-type cs() :: $A..$Z | $a .. $z | $/. + +-spec t() -> $0-$0..$9-$0| $?. + +t() -> + c(#r{f = $z - 3}), + c($z - 3), + c($B). + +-spec c(cs()) -> $3-$0..$9-$0. + +c($A + 1) -> 2; +c(C) -> + case C of + $z - 3 -> 3; + #r{f = $z - 3} -> 7 + end. + +%% Display contract with character in warning: +-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec +f(_) -> ok. + +t1() -> f(#{b => $2}). % breaks the contract diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 21a0da926f..81fa8f187a 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -42,7 +42,7 @@ TARGET_FILES= \ SPEC_FILES = eldap.spec -# COVER_FILE = eldap.cover +COVER_FILE = eldap.cover # ---------------------------------------------------- diff --git a/lib/eldap/test/eldap.cover b/lib/eldap/test/eldap.cover new file mode 100644 index 0000000000..8c15956e72 --- /dev/null +++ b/lib/eldap/test/eldap.cover @@ -0,0 +1,3 @@ +{incl_app,eldap,details}. + +{excl_mods, eldap, ['ELDAPv3']}. diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml index f1e52b1889..426f6b88ca 100644 --- a/lib/erl_interface/doc/src/erl_call.xml +++ b/lib/erl_interface/doc/src/erl_call.xml @@ -193,7 +193,7 @@ erl_call -s -a 'erlang halt' -n madonna <p>To apply with many arguments:</p> <code type="none"><![CDATA[ -erl_call -s -a 'lists map [{math,sqrt},[1,4,9,16,25]]' -n madonna +erl_call -s -a 'lists seq [1,10]' -n madonna ]]></code> <p>To evaluate some expressions diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 226a5d0f61..a5a3e8c136 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-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. @@ -236,7 +236,8 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). +-export_type([erl_type/0, opaques/0, type_table/0, mod_records/0, + var_table/0, cache/0]). %%-define(DEBUG, true). @@ -379,8 +380,9 @@ -type type_value() :: {{module(), {file:name(), erl_anno:line()}, erl_parse:abstract_type(), ArgNames :: [atom()]}, erl_type()}. --type type_table() :: dict:dict(record_key() | type_key(), - record_value() | type_value()). +-type type_table() :: #{record_key() | type_key() => + record_value() | type_value()}. +-type mod_records() :: dict:dict(module(), type_table()). -opaque var_table() :: #{atom() => erl_type()}. @@ -524,7 +526,8 @@ list_contains_opaque(List, Opaques) -> lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List). %% t_find_opaque_mismatch/2 of two types should only be used if their -%% t_inf is t_none() due to some opaque type violation. +%% t_inf is t_none() due to some opaque type violation. However, +%% 'error' is returned if a structure mismatch is found. %% %% The first argument of the function is the pattern and its second %% argument the type we are matching against the pattern. @@ -533,22 +536,30 @@ list_contains_opaque(List, Opaques) -> 'error' | {'ok', erl_type(), erl_type()}. t_find_opaque_mismatch(T1, T2, Opaques) -> - t_find_opaque_mismatch(T1, T2, T2, Opaques). + catch t_find_opaque_mismatch(T1, T2, T2, Opaques). t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error; -t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> error; +t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error); t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) -> t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques); t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) -> case is_opaque_type(T2, Opaques) of - false -> {ok, TopType, T2}; + false -> + case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of + true -> error; + false -> {ok, TopType, T2} + end; true -> t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques) end; t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) -> %% The generated message is somewhat misleading: case is_opaque_type(T1, Opaques) of - false -> {ok, TopType, T1}; + false -> + case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of + true -> error; + false -> {ok, TopType, T1} + end; true -> t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques) end; @@ -564,7 +575,11 @@ t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques); t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) -> t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques); -t_find_opaque_mismatch(_T1, _T2, _TopType, _Opaques) -> error. +t_find_opaque_mismatch(T1, T2, _TopType, Opaques) -> + case t_is_none(t_inf(T1, T2, Opaques)) of + false -> error; + true -> throw(error) + end. t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> List = lists:zipwith(fun(T1, T2) -> @@ -573,10 +588,11 @@ t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> t_find_opaque_mismatch_list(List). t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) -> - List = [t_find_opaque_mismatch(T1, T2, T2, Opaques) || T1 <- L1, T2 <- L2], + List = [catch t_find_opaque_mismatch(T1, T2, T2, Opaques) || + T1 <- L1, T2 <- L2], t_find_opaque_mismatch_list(List). -t_find_opaque_mismatch_list([]) -> error; +t_find_opaque_mismatch_list([]) -> throw(error); t_find_opaque_mismatch_list([H|T]) -> case H of {ok, _T1, _T2} -> H; @@ -749,16 +765,16 @@ decorate_tuples_in_sets([], _L, _Opaques, Acc) -> -spec t_opaque_from_records(type_table()) -> [erl_type()]. -t_opaque_from_records(RecDict) -> - OpaqueRecDict = - dict:filter(fun(Key, _Value) -> +t_opaque_from_records(RecMap) -> + OpaqueRecMap = + maps:filter(fun(Key, _Value) -> case Key of {opaque, _Name, _Arity} -> true; _ -> false end - end, RecDict), - OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, + end, RecMap), + OpaqueTypeMap = + maps:map(fun({opaque, Name, _Arity}, {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), @@ -767,8 +783,8 @@ t_opaque_from_records(RecDict) -> Rep = t_any(), % not used for anything right now Args = [t_any() || _ <- ArgNames], t_opaque(Module, Name, Args, Rep) - end, OpaqueRecDict), - [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)]. + end, OpaqueRecMap), + [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)]. %% Decompose opaque instances of type arg2 to structured types, in arg1 %% XXX: Same as t_unopaque @@ -802,10 +818,6 @@ list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- - --type mod_records() :: dict:dict(module(), type_table()). - -%%----------------------------------------------------------------------------- %% Unit type. Signals non termination. %% @@ -2245,16 +2257,21 @@ t_has_var_list([]) -> false. -spec t_collect_vars(erl_type()) -> [erl_type()]. t_collect_vars(T) -> - t_collect_vars(T, []). + Vs = t_collect_vars(T, maps:new()), + [V || {V, _} <- maps:to_list(Vs)]. --spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()]. +-type ctab() :: #{erl_type() => 'any'}. + +-spec t_collect_vars(erl_type(), ctab()) -> ctab(). t_collect_vars(?var(_) = Var, Acc) -> - ordsets:add_element(Var, Acc); + maps:put(Var, any, Acc); t_collect_vars(?function(Domain, Range), Acc) -> - ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, [])); + Acc1 = t_collect_vars(Domain, Acc), + t_collect_vars(Range, Acc1); t_collect_vars(?list(Contents, Termination, _), Acc) -> - ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); + Acc1 = t_collect_vars(Contents, Acc), + t_collect_vars(Termination, Acc1); t_collect_vars(?product(Types), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> @@ -3052,6 +3069,9 @@ inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) -> end end. +compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) -> + [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)]. + is_compat_opaque_names(Opaque1, Opaque2) -> #opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1, #opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2, @@ -3067,88 +3087,91 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A1, A2) -> - is_specialization(A1, A2) orelse is_specialization(A2, A1). - --spec is_specialization(erl_type(), erl_type()) -> boolean(). - -%% Returns true if the first argument is a specialization of the -%% second argument in the sense that every type is a specialization of -%% any(). For example, {_,_} is a specialization of any(), but not of -%% tuple(). Does not handle variables, but any() and unions (sort of). - -is_specialization(T, T) -> true; -is_specialization(_, ?any) -> true; -is_specialization(?any, _) -> false; -is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> - (is_specialization(Domain1, Domain2) andalso - is_specialization(Range1, Range2)); -is_specialization(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2)) -> +-spec is_compat_arg(erl_type(), erl_type()) -> boolean(). + +%% The intention is that 'true' is to be returned iff one of the +%% arguments is a specialization of the other argument in the sense +%% that every type is a specialization of any(). For example, {_,_} is +%% a specialization of any(), but not of tuple(). Does not handle +%% variables, but any() and unions (sort of). However, the +%% implementation is more relaxed as any() is compatible to anything. + +is_compat_arg(T, T) -> true; +is_compat_arg(_, ?any) -> true; +is_compat_arg(?any, _) -> true; +is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + (is_compat_arg(Domain1, Domain2) andalso + is_compat_arg(Range1, Range2)); +is_compat_arg(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> (Size1 =:= Size2 andalso - is_specialization(Contents1, Contents2) andalso - is_specialization(Termination1, Termination2)); -is_specialization(?product(Types1), ?product(Types2)) -> - specialization_list(Types1, Types2); -is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; -is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; -is_specialization(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(Elements1, Elements2); -is_specialization(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(sup_tuple_elements(List), Elements2); -is_specialization(?tuple(Elements1, Arity, _), - ?tuple_set([{Arity, List}])) when Arity =/= ?any -> - specialization_list(Elements1, sup_tuple_elements(List)); -is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> + is_compat_arg(Contents1, Contents2) andalso + is_compat_arg(Termination1, Termination2)); +is_compat_arg(?product(Types1), ?product(Types2)) -> + is_compat_list(Types1, Types2); +is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) -> + (is_compat_list(Pairs1, Pairs2) andalso + is_compat_arg(DefK1, DefK2) andalso + is_compat_arg(DefV1, DefV2)); +is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; +is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(Elements1, Elements2); +is_compat_arg(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(sup_tuple_elements(List), Elements2); +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple_set([{Arity, List}])) when Arity =/= ?any -> + is_compat_list(Elements1, sup_tuple_elements(List)); +is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], - [sup_tuple_elements(T) || {_Arity, T} <- List2]) + is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; -is_specialization(?opaque(_) = T1, T2) -> - is_specialization(t_opaque_structure(T1), T2); -is_specialization(T1, ?opaque(_) = T2) -> - is_specialization(T1, t_opaque_structure(T2)); -is_specialization(?union(List1)=T1, ?union(List2)=T2) -> - case specialization_union2(T1, T2) of - {yes, Type1, Type2} -> is_specialization(Type1, Type2); - no -> specialization_list(List1, List2) +is_compat_arg(?opaque(_) = T1, T2) -> + is_compat_arg(t_opaque_structure(T1), T2); +is_compat_arg(T1, ?opaque(_) = T2) -> + is_compat_arg(T1, t_opaque_structure(T2)); +is_compat_arg(?union(List1)=T1, ?union(List2)=T2) -> + case is_compat_union2(T1, T2) of + {yes, Type1, Type2} -> is_compat_arg(Type1, Type2); + no -> is_compat_list(List1, List2) end; -is_specialization(?union(List), T2) -> +is_compat_arg(?union(List), T2) -> case unify_union(List) of - {yes, Type} -> is_specialization(Type, T2); + {yes, Type} -> is_compat_arg(Type, T2); no -> false end; -is_specialization(T1, ?union(List)) -> +is_compat_arg(T1, ?union(List)) -> case unify_union(List) of - {yes, Type} -> is_specialization(T1, Type); + {yes, Type} -> is_compat_arg(T1, Type); no -> false end; -is_specialization(?var(_), _) -> exit(error); -is_specialization(_, ?var(_)) -> exit(error); -is_specialization(?none, _) -> false; -is_specialization(_, ?none) -> false; -is_specialization(?unit, _) -> false; -is_specialization(_, ?unit) -> false; -is_specialization(#c{}, #c{}) -> false. +is_compat_arg(?var(_), _) -> exit(error); +is_compat_arg(_, ?var(_)) -> exit(error); +is_compat_arg(?none, _) -> false; +is_compat_arg(_, ?none) -> false; +is_compat_arg(?unit, _) -> false; +is_compat_arg(_, ?unit) -> false; +is_compat_arg(#c{}, #c{}) -> false. -specialization_list_list(LL1, LL2) -> - length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2). -specialization_list_list1([], []) -> true; -specialization_list_list1([L1|LL1], [L2|LL2]) -> - specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list1([], []) -> true; +is_compat_list_list1([L1|LL1], [L2|LL2]) -> + is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2). -specialization_list(L1, L2) -> - length(L1) =:= length(L2) andalso specialization_list1(L1, L2). +is_compat_list(L1, L2) -> + length(L1) =:= length(L2) andalso is_compat_list1(L1, L2). -specialization_list1([], []) -> true; -specialization_list1([T1|L1], [T2|L2]) -> - is_specialization(T1, T2) andalso specialization_list1(L1, L2). +is_compat_list1([], []) -> true; +is_compat_list1([T1|L1], [T2|L2]) -> + is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2). -specialization_union2(?union(List1)=T1, ?union(List2)=T2) -> +is_compat_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; {{yes, Type1}, no} -> {yes, Type1, T2}; @@ -4181,7 +4204,7 @@ t_map(Fun, T) -> -spec t_to_string(erl_type()) -> string(). t_to_string(T) -> - t_to_string(T, dict:new()). + t_to_string(T, maps:new()). -spec t_to_string(erl_type(), type_table()) -> string(). @@ -4542,6 +4565,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) -> {t_atom(Atom), L, C}; from_form({integer, _L, Int}, _S, _D, L, C) -> {t_integer(Int), L, C}; +from_form({char, _L, Char}, _S, _D, L, C) -> + {t_integer(Char), L, C}; from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> @@ -5056,6 +5081,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, list_check_record_fields(Args, S, C); check_record_fields({atom, _L, _}, _S, C) -> C; check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({char, _L, _}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; check_record_fields({type, _L, tuple, any}, _S, C) -> C; @@ -5157,6 +5183,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name); t_form_to_string({atom, _L, Atom}) -> io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... ' t_form_to_string({integer, _L, Int}) -> integer_to_list(Int); +t_form_to_string({char, _L, Char}) -> integer_to_list(Char); t_form_to_string({op, _L, _Op, _Arg} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); @@ -5239,7 +5266,7 @@ t_form_to_string({type, _L, union, Args}) -> t_form_to_string({type, _L, Name, []} = T) -> try M = mod, - D0 = dict:new(), + D0 = maps:new(), MR = dict:from_list([{M, D0}]), Site = {type, {M,Name,0}}, V = var_table__new(), @@ -5303,8 +5330,8 @@ is_erl_type(_) -> false. -spec lookup_record(atom(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, List}} when is_list(List) -> @@ -5318,18 +5345,18 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> -spec lookup_record(atom(), arity(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Arity, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. -spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. -lookup_type(Name, Arity, RecDict) -> - case dict:find({type, Name, Arity}, RecDict) of +lookup_type(Name, Arity, Table) -> + case maps:find({type, Name, Arity}, Table) of error -> - case dict:find({opaque, Name, Arity}, RecDict) of + case maps:find({opaque, Name, Arity}, Table) of error -> error; {ok, Found} -> {opaque, Found} end; @@ -5339,8 +5366,8 @@ lookup_type(Name, Arity, RecDict) -> -spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> - dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, Table) -> + maps:is_key({TypeOrOpaque, Name, Arity}, Table). cannot_have_opaque(Type, TypeName, TypeNames) -> t_is_none(Type) orelse is_recursive(TypeName, TypeNames). diff --git a/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl new file mode 100644 index 0000000000..807c4b0d0d --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl @@ -0,0 +1,217 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : basic_num_bif.erl +%%% Description : Taken from the compiler test suite +%%%------------------------------------------------------------------- +-module(basic_num_bif). + +-export([test/0]). + +%% Tests optimization of the BIFs: +%% abs/1 +%% float/1 +%% float_to_list/1 +%% integer_to_list/1 +%% list_to_float/1 +%% list_to_integer/1 +%% round/1 +%% trunc/1 + +test() -> + Funs = [fun t_abs/0, fun t_float/0, + fun t_float_to_list/0, fun t_integer_to_list/0, + fun t_list_to_float_safe/0, fun t_list_to_float_risky/0, + fun t_list_to_integer/0, fun t_round/0, fun t_trunc/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +t_abs() -> + %% Floats. + 5.5 = abs(5.5), + 0.0 = abs(0.0), + 100.0 = abs(-100.0), + %% Integers. + 5 = abs(5), + 0 = abs(0), + 100 = abs(-100), + %% The largest smallnum. OTP-3190. + X = (1 bsl 27) - 1, + X = abs(X), + X = abs(X-1)+1, + X = abs(X+1)-1, + X = abs(-X), + X = abs(-X-1)-1, + X = abs(-X+1)+1, + %% Bignums. + BigNum = 13984792374983749, + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +t_float() -> + 0.0 = float(0), + 2.5 = float(2.5), + 0.0 = float(0.0), + -100.55 = float(-100.55), + 42.0 = float(42), + -100.0 = float(-100), + %% Bignums. + 4294967305.0 = float(4294967305), + -4294967305.0 = float(-4294967305), + %% Extremely big bignums. + Big = list_to_integer(lists:duplicate(2000, $1)), + {'EXIT', {badarg, _}} = (catch float(Big)), + ok. + +%% Tests float_to_list/1. + +t_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%% Tests integer_to_list/1. + +t_integer_to_list() -> + "0" = integer_to_list(0), + "42" = integer_to_list(42), + "-42" = integer_to_list(-42), + "-42" = integer_to_list(-42), + "32768" = integer_to_list(32768), + "268435455" = integer_to_list(268435455), + "-268435455" = integer_to_list(-268435455), + "123456932798748738738" = integer_to_list(123456932798748738738), + Big_List = lists:duplicate(2000, $1), + Big = list_to_integer(Big_List), + Big_List = integer_to_list(Big), + ok. + +%% Tests list_to_float/1. + +t_list_to_float_safe() -> + 0.0 = list_to_float("0.0"), + 0.0 = list_to_float("-0.0"), + 0.5 = list_to_float("0.5"), + -0.5 = list_to_float("-0.5"), + 100.0 = list_to_float("1.0e2"), + 127.5 = list_to_float("127.5"), + -199.5 = list_to_float("-199.5"), + ok. + +%% This might crash the emulator... +%% (Known to crash the Unix version of Erlang 4.4.1) + +t_list_to_float_risky() -> + Many_Ones = lists:duplicate(25000, $1), + _ = list_to_float("2."++Many_Ones), + {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), + ok. + +%% Tests list_to_integer/1. + +t_list_to_integer() -> + 0 = list_to_integer("0"), + 0 = list_to_integer("00"), + 0 = list_to_integer("-0"), + 1 = list_to_integer("1"), + -1 = list_to_integer("-1"), + 42 = list_to_integer("42"), + -12 = list_to_integer("-12"), + 32768 = list_to_integer("32768"), + 268435455 = list_to_integer("268435455"), + -268435455 = list_to_integer("-268435455"), + %% Bignums. + 123456932798748738738 = list_to_integer("123456932798748738738"), + _ = list_to_integer(lists:duplicate(2000, $1)), + ok. + +%% Tests round/1. + +t_round() -> + 0 = round(0.0), + 0 = round(0.4), + 1 = round(0.5), + 0 = round(-0.4), + -1 = round(-0.5), + 255 = round(255.3), + 256 = round(255.6), + -1033 = round(-1033.3), + -1034 = round(-1033.6), + %% OTP-3722: + X = (1 bsl 27) - 1, + MX = -X, + MXm1 = -X-1, + MXp1 = -X+1, + F = X + 0.0, + X = round(F), + X = round(F+1)-1, + X = round(F-1)+1, + MX = round(-F), + MXm1 = round(-F-1), + MXp1 = round(-F+1), + X = round(F+0.1), + X = round(F+1+0.1)-1, + X = round(F-1+0.1)+1, + MX = round(-F+0.1), + MXm1 = round(-F-1+0.1), + MXp1 = round(-F+1+0.1), + X = round(F-0.1), + X = round(F+1-0.1)-1, + X = round(F-1-0.1)+1, + MX = round(-F-0.1), + MXm1 = round(-F-1-0.1), + MXp1 = round(-F+1-0.1), + 0.5 = abs(round(F+0.5)-(F+0.5)), + 0.5 = abs(round(F-0.5)-(F-0.5)), + 0.5 = abs(round(-F-0.5)-(-F-0.5)), + 0.5 = abs(round(-F+0.5)-(-F+0.5)), + %% Bignums. + 4294967296 = round(4294967296.1), + 4294967297 = round(4294967296.9), + -4294967296 = -round(4294967296.1), + -4294967297 = -round(4294967296.9), + ok. + +t_trunc() -> + 0 = trunc(0.0), + 5 = trunc(5.3333), + -10 = trunc(-10.978987), + %% The largest smallnum, converted to float (OTP-3722): + X = (1 bsl 27) - 1, + F = X + 0.0, + %% io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", + %% [X, X, binary_to_list(term_to_binary(X)), + %% F, F, binary_to_list(term_to_binary(F)), + %% trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), + X = trunc(F), + X = trunc(F+1)-1, + X = trunc(F-1)+1, + X = -trunc(-F), + X = -trunc(-F-1)-1, + X = -trunc(-F+1)+1, + %% Bignums. + 4294967305 = trunc(4294967305.7), + -4294967305 = trunc(-4294967305.7), + ok. diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl index a5b3924aa8..b9adb660f2 100644 --- a/lib/hipe/test/hipe_SUITE.erl +++ b/lib/hipe/test/hipe_SUITE.erl @@ -16,7 +16,11 @@ %% -module(hipe_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + app/0, app/1, appup/0, appup/1]). + -include_lib("common_test/include/ct.hrl"). all() -> diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl index 61952e81d7..86083fa02b 100644 --- a/lib/hipe/test/opt_verify_SUITE.erl +++ b/lib/hipe/test/opt_verify_SUITE.erl @@ -1,6 +1,9 @@ -module(opt_verify_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + call_elim/0, call_elim/1]). all() -> [call_elim]. @@ -23,23 +26,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -call_elim_test_file(Config, FileName, Option) -> - PrivDir = test_server:lookup_config(priv_dir, Config), - TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), - {ok, TestCase} = compile:file(FileName), - {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), - {ok, Icode} = file:read_file(TempOut), - ok = file:delete(TempOut), - Icode. - -substring_count(Icode, Substring) -> - substring_count(Icode, Substring, 0). -substring_count(Icode, Substring, N) -> - case string:str(Icode, Substring) of - 0 -> N; - I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) - end. - call_elim() -> [{doc, "Test that the call elimination optimization pass is ok"}]. call_elim(Config) -> @@ -60,3 +46,20 @@ call_elim(Config) -> Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim), 3 = substring_count(binary:bin_to_list(Icode6), "is_key"), ok. + +call_elim_test_file(Config, FileName, Option) -> + PrivDir = test_server:lookup_config(priv_dir, Config), + TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), + {ok, TestCase} = compile:file(FileName), + {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), + {ok, Icode} = file:read_file(TempOut), + ok = file:delete(TempOut), + Icode. + +substring_count(Icode, Substring) -> + substring_count(Icode, Substring, 0). +substring_count(Icode, Substring, N) -> + case string:str(Icode, Substring) of + 0 -> N; + I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) + end. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 705afec022..4217b3c4fb 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -83,7 +83,7 @@ <title>HTTP DATA TYPES</title> <p>Type definitions related to HTTP:</p> - <p><c>method() = head | get | put | post | trace | options | delete</c></p> + <p><c>method() = head | get | put | post | trace | options | delete | patch</c></p> <taglist> <tag><c>request()</c></tag> <item><p>= <c>{url(), headers()}</c></p> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 398fc7e5b6..5c3b5a2d3c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.4</title> + <section><title>Inets 6.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct misstakes in ftp client introduced in inets-6.3.4</p> + <p> + Own Id: OTP-14203 Aux Id: OTP-13982 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 911f5b71a7..23d6483291 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = {recv_file, Fd}} = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} -> - case file_close(Fd) of - ok -> ok; - {error,einval} -> ok - end, + file_close(Fd), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), {noreply, State#state{dsock = undefined, data = <<>>}}; @@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) -> end; handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> - case file_close(Fd) of - ok -> ok; - {error, einval} -> ok - end, + file_close(Fd), close_data_connection(State), ctrl_result_response(Status, State#state{dsock = undefined}, {error, epath}); @@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) -> send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) -> verbose(lists:flatten(Message),Verbose,send), ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]), - ok = send_message(Socket, Message). + _ = send_message(Socket, Message). send_data_message(_S=#state{dsock = Socket}, Message) -> ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]), @@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) -> send_message({ssl, Socket}, Message) -> ssl:send(Socket, Message). -activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) -> - ok = activate_connection(Socket); -activate_ctrl_connection(#state{csock = Socket}) -> - ok = activate_connection(Socket), +activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) -> + activate_connection(CSock); +activate_ctrl_connection(#state{csock = CSock}) -> + activate_connection(CSock), %% We have already received at least part of the next control message, %% that has been saved in ctrl_data, process this first. - self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>}, + self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>}, ok. +activate_data_connection(#state{dsock = DSock} = State) -> + activate_connection(DSock), + State. + +activate_connection(Socket) -> + ignore_return_value( + case socket_type(Socket) of + tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]); + ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}]) + end). + + +ignore_return_value(_) -> ok. + unwrap_socket({tcp,Socket}) -> Socket; unwrap_socket({ssl,Socket}) -> Socket. socket_type({tcp,_Socket}) -> tcp; socket_type({ssl,_Socket}) -> ssl. -activate_data_connection(#state{dsock = Socket} = State) -> - ok = activate_connection(Socket), - State. - -activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]); -activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]). - close_ctrl_connection(#state{csock = undefined}) -> ok; close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket). close_data_connection(#state{dsock = undefined}) -> ok; close_data_connection(#state{dsock = Socket}) -> close_connection(Socket). -close_connection({lsock,Socket}) -> gen_tcp:close(Socket); -close_connection({tcp, Socket}) -> gen_tcp:close(Socket); -close_connection({ssl, Socket}) -> ssl:close(Socket). +close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ). %% ------------ FILE HANDLING ---------------------------------------- send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) -> @@ -2408,7 +2409,7 @@ send_file(State, Fd) -> progress_report({binary, Bin}, State), send_file(State, Fd); {ok, _, _} -> - ok = file_close(Fd), + file_close(Fd), close_data_connection(State), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), @@ -2423,7 +2424,7 @@ file_open(File, Option) -> file:open(File, [raw, binary, Option]). file_close(Fd) -> - file:close(Fd). + ignore_return_value( file:close(Fd) ). file_read(Fd) -> case file:read(Fd, ?FILE_BUFSIZE) of diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 91d87289a2..bd5f6df39e 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) -> request(Method, Request, HttpOptions, Options, default_profile()). request(Method, + {Url, Headers, ContentType, TupleBody}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso is_tuple(TupleBody)-> + case check_body_gen(TupleBody) of + ok -> + do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile); + Error -> + Error + end; +request(Method, + {Url, Headers, ContentType, Body}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) -> + do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile); + +request(Method, {Url, Headers}, HTTPOptions, Options, Profile) when (Method =:= options) orelse @@ -155,12 +175,6 @@ request(Method, (Method =:= delete) orelse (Method =:= trace) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -172,21 +186,9 @@ request(Method, handle_request(Method, Url, ParsedUrl, Headers, [], [], HTTPOptions, Options, Profile) end - end; - -request(Method, - {Url, Headers, ContentType, Body}, - HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse - (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {content_type, ContentType}, - {body, Body}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), + end. + +do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) -> case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -196,7 +198,6 @@ request(Method, HTTPOptions, Options, Profile) end. - %%-------------------------------------------------------------------------- %% cancel_request(RequestId) -> ok %% cancel_request(RequestId, Profile) -> ok @@ -209,7 +210,6 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), httpc_manager:cancel_request(RequestId, profile_name(Profile)). @@ -232,7 +232,6 @@ cancel_request(RequestId, Profile) set_options(Options) -> set_options(Options, default_profile()). set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> httpc_manager:set_options(Opts, profile_name(Profile)); @@ -272,7 +271,6 @@ get_options(all = _Options, Profile) -> get_options(Options, Profile) when (is_list(Options) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("get options", [{options, Options}, {profile, Profile}]), case Options -- get_options() of [] -> try @@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) -> store_cookies(SetCookieHeaders, Url, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders}, - {url, Url}, - {profile, Profile}]), try begin %% Since the Address part is not actually used @@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) -> cookie_header(Url, Opts, Profile) when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("cookie header", [{url, Url}, - {opts, Opts}, - {profile, Profile}]), try begin httpc_manager:which_cookies(Url, Opts, profile_name(Profile)) @@ -398,7 +390,6 @@ which_sessions() -> which_sessions(default_profile()). which_sessions(Profile) -> - ?hcrt("which sessions", [{profile, Profile}]), try begin httpc_manager:which_sessions(profile_name(Profile)) @@ -419,7 +410,6 @@ info() -> info(default_profile()). info(Profile) -> - ?hcrt("info", [{profile, Profile}]), try begin httpc_manager:info(profile_name(Profile)) @@ -440,7 +430,6 @@ reset_cookies() -> reset_cookies(default_profile()). reset_cookies(Profile) -> - ?hcrt("reset cookies", [{profile, Profile}]), try begin httpc_manager:reset_cookies(profile_name(Profile)) @@ -458,7 +447,6 @@ reset_cookies(Profile) -> %% same behavior as active once for sockets. %%------------------------------------------------------------------------- stream_next(Pid) -> - ?hcrt("stream next", [{handler, Pid}]), httpc_handler:stream_next(Pid). @@ -466,7 +454,6 @@ stream_next(Pid) -> %%% Behaviour callbacks %%%======================================================================== start_standalone(PropList) -> - ?hcrt("start standalone", [{proplist, PropList}]), case proplists:get_value(profile, PropList) of undefined -> {error, no_profile}; @@ -477,14 +464,11 @@ start_standalone(PropList) -> end. start_service(Config) -> - ?hcrt("start service", [{config, Config}]), httpc_profile_sup:start_child(Config). stop_service(Profile) when is_atom(Profile) -> - ?hcrt("stop service", [{profile, Profile}]), httpc_profile_sup:stop_child(Profile); stop_service(Pid) when is_pid(Pid) -> - ?hcrt("stop service", [{pid, Pid}]), case service_info(Pid) of {ok, [{profile, Profile}]} -> stop_service(Profile); @@ -510,7 +494,6 @@ service_info(Pid) -> %%%======================================================================== %%% Internal functions %%%======================================================================== - handle_request(Method, Url, {Scheme, UserInfo, Host, Port, Path, Query}, Headers0, ContentType, Body0, @@ -521,9 +504,6 @@ handle_request(Method, Url, try begin - ?hcrt("begin processing", [{started, Started}, - {new_headers, NewHeaders0}]), - {NewHeaders, Body} = case Body0 of {chunkify, ProcessBody, Acc} @@ -575,16 +555,13 @@ handle_request(Method, Url, {ok, RequestId} -> handle_answer(RequestId, Sync, Options); {error, Reason} -> - ?hcrd("request failed", [{reason, Reason}]), {error, Reason} end end catch error:{noproc, _} -> - ?hcrv("noproc", [{profile, Profile}]), {error, {not_started, Profile}}; throw:Error -> - ?hcrv("throw", [{error, Error}]), Error end. @@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) -> handle_answer(RequestId, true, Options) -> receive {http, {RequestId, saved_to_file}} -> - ?hcrt("received saved-to-file", [{request_id, RequestId}]), {ok, saved_to_file}; {http, {RequestId, {_,_,_} = Result}} -> - ?hcrt("received answer", [{request_id, RequestId}, - {result, Result}]), return_answer(Options, Result); {http, {RequestId, {error, Reason}}} -> - ?hcrt("received error", [{request_id, RequestId}, - {reason, Reason}]), {error, Reason} end. @@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) -> child_name(Pid, [_ | Children]) -> child_name(Pid, Children). -%% d(F) -> -%% d(F, []). - -%% d(F, A) -> -%% d(get(dbg), F, A). - -%% d(true, F, A) -> -%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); -%% d(_, _, _) -> -%% ok. - host_address(Host, false) -> Host; host_address(Host, true) -> string:strip(string:strip(Host, right, $]), left, $[). + +check_body_gen({Fun, _}) when is_function(Fun) -> + ok; +check_body_gen({chunkify, Fun, _}) when is_function(Fun) -> + ok; +check_body_gen(Gen) -> + {error, {bad_body_generator, Gen}}. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 2e7df8e424..c99200777b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,6 @@ %% Internal Application API -export([ start_link/4, - %% connect_and_send/2, send/2, cancel/2, stream_next/1, @@ -165,14 +164,12 @@ info(Pid) -> %%-------------------------------------------------------------------- %% Request should not be streamed stream(BodyPart, #request{stream = none} = Request, _) -> - ?hcrt("stream - none", []), {false, BodyPart, Request}; %% Stream to caller stream(BodyPart, #request{stream = Self} = Request, Code) when ?IS_STREAMED(Code) andalso ((Self =:= self) orelse (Self =:= {self, once})) -> - ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, {Request#request.id, stream, BodyPart}), {true, <<>>, Request}; @@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code) %% We keep this for backward compatibillity... stream(BodyPart, #request{stream = Filename} = Request, Code) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), stream(BodyPart, Request#request{stream = Fd}, 200); {error, Reason} -> exit({stream_to_file_failed, Reason}) @@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) %% Stream to file stream(BodyPart, #request{stream = Fd} = Request, Code) when ?IS_STREAMED(Code) -> - ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of ok -> {true, <<>>, Request}; @@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed - ?hcrt("stream - ignore", [{request, Request}]), {false, BodyPart, Request}. @@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) -> %% {stop, Reason, State} (terminate/2 is called) %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call(#request{address = Addr} = Request, _, +handle_call(Request, From, State) -> + try do_handle_call(Request, From, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(Msg, State) -> + try do_handle_cast(Msg, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%-------------------------------------------------------------------- +handle_info(Info, State) -> + try do_handle_info(Info, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- + +%% Init error there is no socket to be closed. +terminate(normal, + #state{request = Request, + session = {send_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, + #state{request = Request, + session = {connect_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, #state{session = undefined}) -> + ok; + +%% Init error sending, no session information has been setup but +%% there is a socket that needs closing. +terminate(normal, + #state{session = #session{id = undefined} = Session}) -> + close_socket(Session); + +%% Socket closed remotely +terminate(normal, + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + %% Cancel timers + cancel_timers(Timers), + + %% Maybe deliver answers to requests + deliver_answer(Request), + + %% And, just in case, close our side (**really** overkill) + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + cancel_timer(Timers#timers.queue_timer, timeout_queue), + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{request = undefined}) -> + ok; + +terminate(Reason, #state{request = Request} = State) -> + NewState = maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + terminate(Reason, NewState#state{request = undefined}). + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%%%-------------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State0) when Status =/= undefined -> - - ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of ok -> @@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _, case State0#state.request of #request{} = OldRequest -> %% Old request not yet finished - ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = State1#state.timers, + NewTimers = State1#state.timers, NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = @@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewPipeline) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State1#state{ request = OldRequest, pipeline = NewPipeline, @@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _, undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = @@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), State = init_wait_for_response_state(Request, State1#state{session = NewSession, timers = NewTimers}), {reply, ok, State} end; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), NewPipeline = queue:in(Request, State0#state.pipeline), - {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}} + {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}} end; -handle_call(#request{address = Addr} = Request, _, +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = keep_alive} = Session, timers = Timers, @@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _, profile_name = ProfileName} = State0) when Status =/= undefined -> - ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), - ClientClose = httpc_request:is_client_closing(Request#request.headers), case State0#state.request of #request{} -> %% Old request not yet finished %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), NewKeepAlive = queue:in(Request, State0#state.keep_alive), NewSession = Session#session{queue_length = @@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewKeepAlive) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State0#state{keep_alive = NewKeepAlive, session = NewSession}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewTimers = Timers#timers{queue_timer = undefined}, @@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), - %% Activate the request time out for the new request State2 = activate_request_timeout(State1#state{request = Request}), @@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _, State = init_wait_for_response_state(Request, State2#state{session = NewSession}), {reply, ok, State}; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {stop, shutdown, {keepalive_failed, Reason}, State1} + {stop, {shutdown, {keepalive_failed, Reason}}, State1} end end; - -handle_call(info, _, State) -> +do_handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. -%%-------------------------------------------------------------------- -%% Function: handle_cast(Msg, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling cast messages -%%-------------------------------------------------------------------- - %% When the request in process has been canceled the handler process is %% stopped and the pipelined requests will be reissued or remaining %% requests will be sent on a new connection. This is is @@ -405,145 +500,102 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId}, +do_handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, canceled = Canceled} = State) -> - ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, RequestId}, + #state{request = #request{}, + canceled = Canceled} = State) -> {noreply, State#state{canceled = [RequestId | Canceled]}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = undefined, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, undefined}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, _}, + #state{request = undefined} = State) -> {noreply, State}; - -handle_cast(stream_next, #state{session = Session} = State) -> +do_handle_cast(stream_next, #state{session = Session} = State) -> activate_once(Session), %% Inactivate the #state.once here because we don't want %% next_body_chunk/1 to activate the socket twice. {noreply, State#state{once = inactive}}. - -%%-------------------------------------------------------------------- -%% Function: handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling all non call/cast messages -%%-------------------------------------------------------------------- -handle_info({Proto, _Socket, Data}, +do_handle_info({Proto, _Socket, Data}, #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, + request = #request{method = Method} = Request, session = Session, status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> - ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), - - FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Streamed of - false -> - Length; - true -> - Length - size(Body) - end, - - NewState = next_body_chunk(State, Code), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - {Module, decode_size, - [TotalChunk, HexList, + try Module:Function([Data | Args]) of + {ok, Result} -> + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + {_, Code, _} = StatusLine, + {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Streamed of + false -> + Length; + true -> + Length - size(Body) + end, + + NewState = next_body_chunk(State, Code), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_size", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - {_, Code, _} = StatusLine, - {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_size, - [TotalChunk, HexList, + when BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + {_, Code, _} = StatusLine, + {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_data, + [ChunkSize, TotalChunk, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), + <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, + StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, + NewChunkSize = ChunkSize - ChunkSizeToSteal, + {_, Code, _} = StatusLine, + + {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_data, + [NewChunkSize, NewTotalChunk, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, {noreply, NewState#state{mfa = NewMFA, request = NewRequest}}; - {Module, decode_data, - [ChunkSize, TotalChunk, - {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_data", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), - <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, - StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, - NewChunkSize = ChunkSize - ChunkSizeToSteal, - {_, Code, _} = StatusLine, - - {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_data, - [NewChunkSize, NewTotalChunk, - {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - _:_Reason -> - ?hcrd("data processing exit", [{exit, _Reason}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - end, - ?hcri("data processed", [{final_result, FinalResult}]), - FinalResult; - + NewMFA -> + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + _:Reason -> + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, {shutdown, Reason}, NewState} + end; -handle_info({Proto, Socket, Data}, +do_handle_info({Proto, Socket, Data}, #state{mfa = MFA, request = Request, session = Session, @@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data}, {noreply, State}; - %% The Server may close the connection to indicate that the %% whole body is now sent instead of sending an length %% indicator. -handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); -handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); %%% Server closes idle pipeline -handle_info({tcp_closed, _}, State = #state{request = undefined}) -> +do_handle_info({tcp_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; -handle_info({ssl_closed, _}, State = #state{request = undefined}) -> +do_handle_info({ssl_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%% Error cases -handle_info({tcp_closed, _}, #state{session = Session0} = State) -> +do_handle_info({tcp_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({ssl_closed, _}, #state{session = Session0} = State) -> +do_handle_info({ssl_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({tcp_error, _, _} = Reason, State) -> +do_handle_info({tcp_error, _, _} = Reason, State) -> {stop, Reason, State}; -handle_info({ssl_error, _, _} = Reason, State) -> +do_handle_info({ssl_error, _, _} = Reason, State) -> {stop, Reason, State}; %% Timeouts %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{request = #request{id = RequestId} = Request, canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, canceled = [RequestId | Canceled]}}; -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout", [{id, RequestId}]), Filter = fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), %% Notify the owner httpc_response:send(From, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), [Request#request{from = answer_sent}]; (_) -> true end, case State#state.status of pipeline -> - ?hcrd("pipeline", []), Pipeline = queue:filter(Filter, State#state.pipeline), {noreply, State#state{canceled = [RequestId | Canceled], pipeline = Pipeline}}; keep_alive -> - ?hcrd("keep_alive", []), KeepAlive = queue:filter(Filter, State#state.keep_alive), {noreply, State#state{canceled = [RequestId | Canceled], keep_alive = KeepAlive}} end; -handle_info(timeout_queue, State = #state{request = undefined}) -> +do_handle_info(timeout_queue, State = #state{request = undefined}) -> {stop, normal, State}; %% Timing was such as the queue_timeout was not canceled! -handle_info(timeout_queue, #state{timers = Timers} = State) -> +do_handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. -handle_info({init_error, Tag, ClientErrMsg}, +do_handle_info({init_error, Reason, ClientErrMsg}, State = #state{request = Request}) -> - ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - + {stop, {shutdown, Reason}, NewState}; %%% httpc_manager process dies. -handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> +do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%Try to finish the current request anyway, %% there is a fairly high probability that it can be done successfully. %% Then close the connection, hopefully a new manager is started that %% can retry requests in the pipeline. -handle_info({'EXIT', _, _}, State) -> +do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. -%%-------------------------------------------------------------------- -%% Function: terminate(Reason, State) -> _ (ignored by gen_server) -%% Description: Shutdown the httpc_handler -%%-------------------------------------------------------------------- - -%% Init error there is no socket to be closed. -terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, #state{session = undefined}) -> - ok; - -%% Init error sending, no session information has been setup but -%% there is a socket that needs closing. -terminate(normal, - #state{session = #session{id = undefined} = Session}) -> - close_socket(Session); - -%% Socket closed remotely -terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - %% Cancel timers - cancel_timers(Timers), - - %% Maybe deliver answers to requests - deliver_answer(Request), - - %% And, just in case, close our side (**really** overkill) - http_transport:close(SocketType, Socket); - -terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - cancel_timer(Timers#timers.queue_timer, timeout_queue), - http_transport:close(SocketType, Socket); +call(Msg, Pid) -> + call(Msg, Pid, infinity). -terminate(Reason, #state{request = undefined}) -> - ?hcrt("terminate", [{reason, Reason}]), - ok; +call(Msg, Pid, Timeout) -> + gen_server:call(Pid, Msg, Timeout). -terminate(Reason, #state{request = Request} = State) -> - ?hcrd("terminate", [{reason, Reason}, {request, Request}]), - NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - terminate(Reason, NewState#state{request = undefined}). +cast(Msg, Pid) -> + gen_server:cast(Pid, Msg). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of @@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). -deliver_answer(#request{id = Id, from = From} = Request) +deliver_answer(#request{from = From} = Request) when is_pid(From) -> Response = httpc_response:error(Request, socket_closed_remotely), - ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]), httpc_response:send(From, Response); -deliver_answer(Request) -> - ?hcrd("skip deliver answer", [{request, Request}]), +deliver_answer(_Request) -> ok. - -%%-------------------------------------------------------------------- -%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} -%% Purpose: Convert process state when code is changed -%%-------------------------------------------------------------------- - -code_change(_, State, _) -> - {ok, State}. - - -%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> -%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}. - -%% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> -%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. - -%% new_queue(Queue, Fun) -> -%% List = queue:to_list(Queue), -%% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), -%% queue:from_list(NewList). - - %%%-------------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -872,26 +799,21 @@ connect(SocketType, ToAddress, connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, - ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + httpc_request:is_client_closing( + Request#request.headers), SessionType = httpc_manager:session_type(Options), SocketType = socket_type(Request), Session = #session{id = {Request#request.address, self()}, scheme = Request#request.scheme, socket = Socket, - socket_type = SocketType, - client_close = ClientClose, - type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, case httpc_request:send(Address, Session, Request) of ok -> - ?hcri("first request sent", []), TmpState = State#state{request = Request, session = Session, mfa = init_mfa(Request, State), @@ -949,12 +871,6 @@ handler_info(#state{request = Request, options = _Options, timers = _Timers} = _State) -> - ?hcrt("handler info", [{request, Request}, - {session, Session}, - {pipeline, Pipeline}, - {keep_alive, KeepAlive}, - {status, Status}]), - %% Info about the current request RequestInfo = case Request of @@ -965,8 +881,6 @@ handler_info(#state{request = Request, [{id, Id}, {started, ReqStarted}] end, - ?hcrt("handler info", [{request_info, RequestInfo}]), - %% Info about the current session/socket SessionType = Session#session.type, QueueLen = case SessionType of @@ -979,22 +893,12 @@ handler_info(#state{request = Request, Socket = Session#session.socket, SocketType = Session#session.socket_type, - ?hcrt("handler info", [{session_type, SessionType}, - {queue_length, QueueLen}, - {scheme, Scheme}, - {socket, Socket}]), - SocketOpts = http_transport:getopts(SocketType, Socket), SocketStats = http_transport:getstat(SocketType, Socket), Remote = http_transport:peername(SocketType, Socket), Local = http_transport:sockname(SocketType, Socket), - ?hcrt("handler info", [{remote, Remote}, - {local, Local}, - {socket_opts, SocketOpts}, - {socket_stats, SocketStats}]), - SocketInfo = [{remote, Remote}, {local, Local}, {socket_opts, SocketOpts}, @@ -1014,7 +918,6 @@ handler_info(#state{request = Request, handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State = #state{request = Request}) -> - ?hcrt("handle_http_msg", [{headers, Headers}]), case Headers#http_response_h.'content-type' of "multipart/byteranges" ++ _Param -> exit({not_yet_implemented, multypart_byteranges}); @@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, end; handle_http_msg({ChunkedHeaders, Body}, #state{status_line = {_, Code, _}, headers = Headers} = State) -> - ?hcrt("handle_http_msg", - [{chunked_headers, ChunkedHeaders}, {headers, Headers}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody, request = NewRequest}); handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> - ?hcrt("handle_http_msg", [{code, Code}]), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). @@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request}, {stop, normal, NewState}; handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> - ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> - ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> - ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); handle_http_body(Body, #state{headers = Headers, max_body_size = MaxBodySize, status_line = {_,Code, _}, request = Request} = State) -> - ?hcrt("handle_http_body", - [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]), TransferEnc = Headers#http_response_h.'transfer-encoding', case case_insensitive_header(TransferEnc) of "chunked" -> - ?hcrt("handle_http_body - chunked", []), try http_chunk:decode(Body, State#state.max_body_size, State#state.max_header_size) of {Module, Function, Args} -> - ?hcrt("handle_http_body - new mfa", - [{module, Module}, - {function, Function}, - {args, Args}]), NewState = next_body_chunk(State, Code), {noreply, NewState#state{mfa = {Module, Function, Args}}}; {ok, {ChunkedHeaders, NewBody}} -> - ?hcrt("handle_http_body - new body", - [{chunked_headers, ChunkedHeaders}, - {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), case Body of @@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Enc when Enc =:= "identity"; Enc =:= undefined -> - ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - other", [{encoding, Encoding}]), NewState = answer_request(Request, httpc_response:error(Request, unknown_encoding), @@ -1152,18 +1037,10 @@ handle_response(#state{request = Request, options = Options, profile_name = ProfileName} = State) when Status =/= new -> - - ?hcrd("handle response", [{profile, ProfileName}, - {status, Status}, - {request, Request}, - {session, Session}, - {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> - ?hcrd("handle response - continue", []), %% Send request body {_, RequestBody} = Request#request.content, send_raw(Session, RequestBody), @@ -1180,7 +1057,6 @@ handle_response(#state{request = Request, %% Ignore unexpected 100-continue response and receive the %% actual response that the server will send right away. {ignore, Data} -> - ?hcrd("handle response - ignore", [{data, Data}]), Relaxed = (Request#request.settings)#http_options.relaxed, MFA = {httpc_response, parse, [State#state.max_header_size, Relaxed]}, @@ -1194,23 +1070,17 @@ handle_response(#state{request = Request, %% obsolete and the manager will create a new request %% with the same id as the current. {redirect, NewRequest, Data} -> - ?hcrt("handle response - redirect", - [{new_request, NewRequest}, {data, Data}]), ok = httpc_manager:redirect_request(NewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {retry, TimeNewRequest, Data} -> - ?hcrt("handle response - retry", - [{time_new_request, TimeNewRequest}, {data, Data}]), ok = httpc_manager:retry_request(TimeNewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> - ?hcrd("handle response - ok", []), stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); {stop, Msg} -> - ?hcrd("handle response - stop", [{msg, Msg}]), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), {stop, normal, NewState} @@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline, profile_name = ProfileName, options = #options{pipeline_timeout = TimeOut}} = State, Data) -> - - ?hcrd("handle pipeline", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.pipeline) of {empty, _} -> - ?hcrd("pipeline queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> - ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request had been cancelled", []), %% See comment for handle_cast({cancel, RequestId}) {stop, normal, State#state{request = NextRequest#request{from = answer_sent}, pipeline = Pipeline}}; false -> - ?hcrv("next request", [{request, NextRequest}]), NewSession = Session#session{queue_length = %% Queue + current @@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive, options = #options{keep_alive_timeout = TimeOut, proxy = Proxy}} = State, Data) -> - - ?hcrd("handle keep_alive", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.keep_alive) of {empty, _} -> - ?hcrd("keep_alive queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> - ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request has already been canceled", []), handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> - ?hcrv("next request", [{request, NextRequest}]), #request{address = Addr} = NextRequest, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, NextRequest) of @@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive, end end end. - handle_empty_queue(Session, ProfileName, TimeOut, State) -> %% The server may choose too terminate an idle pipline| keep_alive session %% in this case we want to receive the close message @@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) -> status_line = undefined, headers = undefined, body = undefined}. - gather_data(<<>>, Session, State) -> activate_once(Session), {noreply, State}; @@ -1381,10 +1231,6 @@ activate_request_timeout( State; _ -> ReqId = Request#request.id, - ?hcrt("activate request timer", - [{request_id, ReqId}, - {time_consumed, t() - Request#request.started}, - {timeout, Timeout}]), Msg = {timeout, ReqId}, Ref = erlang:send_after(Timeout, self(), Msg), Request2 = Request#request{timer = Ref}, @@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive( status_line = {Version, _, _}, headers = Headers, profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), case is_keep_alive_enabled_server(Version, Headers) andalso is_keep_alive_connection(Headers, Session) of true -> @@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, #state{session = Session, timers = Timers, profile_name = ProfileName} = State) -> - ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), RequestTimers = Timers#timers.request_timers, TimerRef = @@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) -> ip_comm; socket_type(#request{scheme = https, settings = Settings}) -> Settings#http_options.ssl. -%% socket_type(http) -> -%% ip_comm; -%% socket_type(https) -> -%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> - ?hcrt("start stream - none", []), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = self} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, ignore), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = {self, once}} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self:once", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, self()), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, _Headers, #request{stream = Filename} = Request) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("start stream", [{code, Code}, {filename, Filename}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcri("start stream - file open ok", [{fd, Fd}]), {ok, Request#request{stream = Fd}}; {error, Reason} -> exit({stream_to_file_failed, Reason}) end; start_stream(_StatusLine, _Headers, Request) -> - ?hcrt("start stream - no op", []), {ok, Request}. stream_remaining_body(<<>>, _, _) -> @@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) -> %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request end_stream(_, #request{stream = none}) -> - ?hcrt("end stream - none", []), ok; end_stream(_, #request{stream = self}) -> - ?hcrt("end stream - self", []), ok; end_stream(_, #request{stream = {self, once}}) -> - ?hcrt("end stream - self:once", []), ok; end_stream({_,200,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 200", [{stream, Fd}]), case file:close(Fd) of ok -> ok; @@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) -> file:close(Fd) end; end_stream({_,206,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 206", [{stream, Fd}]), case file:close(Fd) of ok -> ok; {error, enospc} -> % Could be due to delayed_write file:close(Fd) end; -end_stream(SL, R) -> - ?hcrt("end stream", [{status_line, SL}, {request, R}]), +end_stream(_, _) -> ok. @@ -1702,11 +1527,8 @@ handle_verbose(trace) -> handle_verbose(_) -> ok. - - send_raw(#session{socket = Socket, socket_type = SocketType}, {ProcessBody, Acc}) when is_function(ProcessBody, 1) -> - ?hcrt("send raw", [{acc, Acc}]), send_raw(SocketType, Socket, ProcessBody, Acc); send_raw(#session{socket = Socket, socket_type = SocketType}, Body) -> http_transport:send(SocketType, Socket, Body). @@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> ok; {ok, Data, NewAcc} -> DataBin = iolist_to_binary(Data), - ?hcrd("send", [{data, DataBin}]), case http_transport:send(SocketType, Socket, DataBin) of ok -> send_raw(SocketType, Socket, ProcessBody, NewAcc); @@ -1883,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> end. -%% --------------------------------------------------------------------- - -call(Msg, Pid) -> - call(Msg, Pid, infinity). - -call(Msg, Pid, Timeout) -> - gen_server:call(Pid, Msg, Timeout). - -cast(Msg, Pid) -> - gen_server:cast(Pid, Msg). - -t() -> - http_util:timestamp(). diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index d8bdac24e3..0fd5faa466 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -363,7 +363,7 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> %% Automatic redirection {ok, {Scheme, _, Host, Port, Path, Query}} -> NewHeaders = - (Request#request.headers)#http_request_h{host = Host}, + (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)}, NewRequest = Request#request{redircount = Request#request.redircount+1, diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index 7e20a9ba67..82273c8c74 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -241,9 +241,9 @@ handle_info({tcp_closed, _}, State) -> handle_info({ssl_closed, _}, State) -> {stop, normal, State}; handle_info({tcp_error, _, _} = Reason, State) -> - {stop, Reason, State}; + {stop, {shutdown, Reason}, State}; handle_info({ssl_error, _, _} = Reason, State) -> - {stop, Reason, State}; + {stop, {shutdown, Reason}, State}; %% Timeouts handle_info(timeout, #state{mfa = {_, parse, _}} = State) -> diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 3a31daeb20..d28d4cd766 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,10 +18,14 @@ %% %CopyrightEnd% {"%VSN%", [ + {<<"6.2.4">>, [{load_module, httpd_request_handler, + soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ + {<<"6.2.4">>, [{load_module, httpd_request_handler, + soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index a64ae2b87c..8aea38037d 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -88,7 +88,8 @@ real_requests()-> stream_through_mfa, streaming_error, inet_opts, - invalid_headers + invalid_headers, + invalid_body ]. only_simulated() -> @@ -125,7 +126,9 @@ only_simulated() -> redirect_see_other, redirect_temporary_redirect, port_in_host_header, - relaxed + redirect_port_in_host_header, + relaxed, + multipart_chunks ]. misc() -> @@ -1000,10 +1003,25 @@ invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). +%%------------------------------------------------------------------------- + +invalid_body(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + try + httpc:request(post, {URL, [], <<"text/plain">>, "foobar"}, + [], []), + ct:fail(accepted_invalid_input) + catch + error:function_clause -> + ok + end. + +%%------------------------------------------------------------------------- remote_socket_close(Config) when is_list(Config) -> URL = url(group_name(Config), "/just_close.html", Config), {error, socket_closed_remotely} = httpc:request(URL). + %%------------------------------------------------------------------------- remote_socket_close_async(Config) when is_list(Config) -> @@ -1102,7 +1120,20 @@ port_in_host_header(Config) when is_list(Config) -> Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []}, {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), inets_test_lib:check_body(Body). +%%------------------------------------------------------------------------- +redirect_port_in_host_header(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/redirect_ensure_host_header_with_port.html", Config), []}, + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body). + +%%------------------------------------------------------------------------- +multipart_chunks(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/multipart_chunks.html", Config), []}, + {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]), + ok = receive_stream_n(Ref, 10), + httpc:cancel_request(Ref). + %%------------------------------------------------------------------------- timeout_memory_leak() -> [{doc, "Check OTP-8739"}]. @@ -1398,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) -> end. dummy_server_init(Caller, ip_comm, Inet, _) -> - BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}], {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, @@ -1680,6 +1711,12 @@ handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) -> "HTTP/1.1 500 Internal Server Error\r\n" ++ "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B end; +handle_uri(_,"/redirect_ensure_host_header_with_port.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/ensure_host_header_with_port.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; handle_uri(_,"/300.html",Port,_,Socket,_) -> NewUri = url_start(Socket) ++ @@ -1968,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) -> "Content-Length:32\r\n\n" ++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n" + "Connection: Keep-Alive\r\n" ++ + "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++ + "\r\n", + send(Socket, Head), + send_multipart_chunks(Socket), + http_chunk:encode_last(); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; @@ -2264,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) -> Error -> exit(Error) end. + +send_multipart_chunks(Socket) -> + send(Socket, http_chunk:encode("--chunk_boundary\r\n")), + send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")), + send(Socket, http_chunk:encode("test\r\n")), + ct:sleep(500), + send_multipart_chunks(Socket). + +receive_stream_n(_, 0) -> + ok; +receive_stream_n(Ref, N) -> + receive + {http, {Ref, stream_start, _}} -> + receive_stream_n(Ref, N); + {http, {Ref,stream, Data}} -> + ct:pal("Data: ~p", [Data]), + receive_stream_n(Ref, N-1) + end. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index eef5abd610..9591ab22ed 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.4 +INETS_VSN = 6.3.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 59a046bf4d..5b5b71e521 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -37,10 +37,7 @@ the <c>heart</c> port program is to check that the Erlang runtime system it is supervising is still running. If the port program has not received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds - (defaults to 60 seconds), the system can be rebooted. Also, if - the system is equipped with a hardware watchdog timer and is - running Solaris, the watchdog can be used to supervise the entire - system.</p> + (defaults to 60 seconds), the system can be rebooted.</p> <p>An Erlang runtime system to be monitored by a heart program is to be started with command-line flag <c>-heart</c> (see also <seealso marker="erts:erl"><c>erl(1)</c></seealso>). @@ -51,17 +48,13 @@ or a terminated Erlang runtime system, environment variable <c>HEART_COMMAND</c> must be set before the system is started. If this variable is not set, a warning text is printed but - the system does not reboot. However, if the hardware watchdog is - used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c> - seconds later (defaults to 60 seconds).</p> + the system does not reboot.</p> <p>To reboot on Windows, <c>HEART_COMMAND</c> can be set to <c>heart -shutdown</c> (included in the Erlang delivery) or to any other suitable program that can activate a reboot.</p> - <p>The hardware watchdog is not started under Solaris if - environment variable <c>HW_WD_DISABLE</c> is set.</p> - <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and - <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart - time-outs; they can be set in the operating system shell before Erlang + <p>The environment variable <c>HEART_BEAT_TIMEOUT</c> + can be used to configure the heart + time-outs; it can be set in the operating system shell before Erlang is started or be specified at the command line:</p> <pre> % <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre> diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 3523f680a3..3ee8e2c6e6 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -360,8 +360,12 @@ init(Max) when is_integer(Max) -> %% go back. init({go_back, _PostState}) -> {ok, {?buffer_size, 0, []}}; -init(_) -> %% Start and just relay to other - {ok, []}. %% node if node(GLeader) =/= node(). +init(_) -> + %% The error logger process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + process_flag(message_queue_data, off_heap), + {ok, []}. -spec handle_event(term(), state()) -> {'ok', state()}. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 58b601e456..6d94f7770f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1413,7 +1413,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> case open(FileName, Mode) of {ok, Fd} -> {ok, Fd, FileName}; - {error, enoent} -> + {error, Reason} when Reason =:= enoent; Reason =:= enotdir -> path_open_first(Rest, Name, Mode, LastError); Error -> Error diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index eea78aabdf..8fa48d56fb 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -198,16 +198,11 @@ start_portprogram() -> end. get_heart_timeouts() -> - HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of - false -> ""; - H when is_list(H) -> - "-ht " ++ H - end, - HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of - false -> ""; - W when is_list(W) -> - " -wt " ++ W - end. + case os:getenv("HEART_BEAT_TIMEOUT") of + false -> ""; + H when is_list(H) -> + "-ht " ++ H + end. check_start_heart() -> case init:get_argument(heart) of diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index f8519d3a5e..03d4324992 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -289,12 +289,11 @@ get_data(Port, MonRef, Eot, Sofar) -> more -> get_data(Port, MonRef, Eot, [Sofar,Bytes]); Last -> - Port ! {self(), close}, - flush_until_closed(Port), - flush_exit(Port), + catch port_close(Port), + flush_until_down(Port, MonRef), iolist_to_binary([Sofar, Last]) end; - {'DOWN', MonRef, _, _ , _} -> + {'DOWN', MonRef, _, _, _} -> flush_exit(Port), iolist_to_binary(Sofar) end. @@ -308,18 +307,25 @@ eot(Bs, Eot) -> binary:part(Bs,{0, Pos}) end. -flush_until_closed(Port) -> +%% When port_close returns we know that all the +%% messages sent have been sent and that the +%% DOWN message is after them all. +flush_until_down(Port, MonRef) -> receive {Port, {data, _Bytes}} -> - flush_until_closed(Port); - {Port, closed} -> - true + flush_until_down(Port, MonRef); + {'DOWN', MonRef, _, _, _} -> + flush_exit(Port) end. +%% The exit signal is always delivered before +%% the down signal, so we can be sure that if there +%% was an exit message sent, it will be in the +%% mailbox now. flush_exit(Port) -> receive {'EXIT', Port, _} -> ok - after 1 -> % force context switch + after 0 -> ok end. diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 21bff02214..bd6ea26678 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -67,17 +67,27 @@ %%------------------------------------------------------------------------ + +%% The rex server may receive a huge amount of +%% messages. Make sure that they are stored off heap to +%% avoid exessive GCs. + +-define(SPAWN_OPTS, [{spawn_opt,[{message_queue_data,off_heap}]}]). + %% Remote execution and broadcasting facility -spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}. start() -> - gen_server:start({local,?NAME}, ?MODULE, [], []). + gen_server:start({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). -spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. start_link() -> - gen_server:start_link({local,?NAME}, ?MODULE, [], []). + %% The rex server process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + gen_server:start_link({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). -spec stop() -> term(). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index c5167efa56..5777b397b8 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -588,20 +588,28 @@ sticky_compiler(Files, PrivDir) -> [R || R <- Rets, R =/= ok]. do_sticky_compile(Mod, Dir) -> - %% Make sure that the module is loaded. A module being sticky - %% only prevents it from begin reloaded, not from being loaded - %% from the wrong place to begin with. - Mod = Mod:module_info(module), - File = filename:append(Dir, atom_to_list(Mod)), - Src = io_lib:format("-module(~s).\n" - "-export([test/1]).\n" - "test(me) -> fail.\n", [Mod]), - ok = file:write_file(File++".erl", Src), - case c:c(File, [{outdir,Dir}]) of - {ok,Module} -> - Module:test(me); - {error,sticky_directory} -> - ok + case code:is_sticky(Mod) of + true -> + %% Make sure that the module is loaded. A module being sticky + %% only prevents it from begin reloaded, not from being loaded + %% from the wrong place to begin with. + Mod = Mod:module_info(module), + File = filename:append(Dir, atom_to_list(Mod)), + Src = io_lib:format("-module(~s).\n" + "-export([test/1]).\n" + "test(me) -> fail.\n", [Mod]), + ok = file:write_file(File++".erl", Src), + case c:c(File, [{outdir,Dir}]) of + {ok,Module} -> + Module:test(me); + {error,sticky_directory} -> + ok + end; + false -> + %% For some reason the module is not sticky + %% could be that the .erlang file has + %% unstuck it? + {Mod, is_not_sticky} end. %% Test that the -pa and -pz options work as expected. diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl index b6e7551741..bb01c2384d 100644 --- a/lib/kernel/test/error_logger_SUITE.erl +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -30,6 +30,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, + off_heap/1, error_report/1, info_report/1, error/1, info/1, emulator/1, tty/1, logfile/1, add/1, delete/1]). @@ -45,7 +46,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [error_report, info_report, error, info, emulator, tty, + [off_heap, error_report, info_report, error, info, emulator, tty, logfile, add, delete]. groups() -> @@ -66,6 +67,16 @@ end_per_group(_GroupName, Config) -> %%----------------------------------------------------------------- +off_heap(_Config) -> + %% The error_logger process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + MQD = message_queue_data, + {MQD,off_heap} = process_info(whereis(error_logger), MQD), + ok. + +%%----------------------------------------------------------------- + error_report(Config) when is_list(Config) -> error_logger:add_report_handler(?MODULE, self()), Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}], diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index 1c72ddc87f..d76c4097d8 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([call/1, block_call/1, multicall/1, multicall_timeout/1, +-export([off_heap/1, + call/1, block_call/1, multicall/1, multicall_timeout/1, multicall_dies/1, multicall_node_dies/1, called_dies/1, called_node_dies/1, called_throws/1, call_benchmark/1, async_call/1]). @@ -35,7 +36,7 @@ suite() -> {timetrap,{minutes,2}}]. all() -> - [call, block_call, multicall, multicall_timeout, + [off_heap, call, block_call, multicall, multicall_timeout, multicall_dies, multicall_node_dies, called_dies, called_node_dies, called_throws, call_benchmark, async_call]. @@ -55,6 +56,13 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +off_heap(_Config) -> + %% The rex server process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + MQD = message_queue_data, + {MQD,off_heap} = process_info(whereis(rex), MQD), + ok. %% Test different rpc calls. diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 51c98d0d3e..9f59759cb6 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -39,7 +39,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.14.2</title> + <section><title>Mnesia 4.14.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed crash in checkpoint handling when table was deleted + during backup.</p> + <p> + Own Id: OTP-14167</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.14.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 9eb939e8d3..fc626940b4 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -909,7 +909,7 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) -> retainer_loop(Cp2); {From, {iter_end, Iter}} -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), Iters = Cp#checkpoint_args.iterators -- [Iter], reply(From, Name, ok), retainer_loop(Cp#checkpoint_args{iterators = Iters}); @@ -971,7 +971,8 @@ do_stop(Cp) -> unset({checkpoint, Name}), lists:foreach(fun deactivate_tab/1, Cp#checkpoint_args.retainers), Iters = Cp#checkpoint_args.iterators, - lists:foreach(fun(I) -> retainer_fixtable(I#iter.oid_tab, false) end, Iters). + [?SAFE(retainer_fixtable(Tab, false)) || #iter{main_tab=Tab} <- Iters], + ok. deactivate_tab(R) -> Name = R#retainer.cp_name, @@ -1151,7 +1152,7 @@ do_change_copy(Cp, Tab, FromType, ToType) -> Cp#checkpoint_args{retainers = Rs, nodes = writers(Rs)}. check_iter(From, Iter) when Iter#iter.pid == From -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), false; check_iter(_From, _Iter) -> true. diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 7320d381ea..6f7531245f 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -114,7 +114,8 @@ handle_table_event({Oper, Record, TransId}, State) -> handle_system_event({mnesia_checkpoint_activated, _Checkpoint}, State) -> {ok, State}; -handle_system_event({mnesia_checkpoint_deactivated, _Checkpoint}, State) -> +handle_system_event({mnesia_checkpoint_deactivated, Checkpoint}, State) -> + report_error("Checkpoint '~p' has been deactivated, last table copy deleted.\n",[Checkpoint]), {ok, State}; handle_system_event({mnesia_up, Node}, State) -> diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index e745ec9b04..044cf501fd 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -723,18 +723,18 @@ bup_records(File, Mod) -> exit(Reason) end. -sops_with_checkpoint(doc) -> +sops_with_checkpoint(doc) -> ["Test schema operations during a checkpoint"]; sops_with_checkpoint(suite) -> []; sops_with_checkpoint(Config) when is_list(Config) -> - Ns = ?acquire_nodes(2, Config), - + Ns = [N1,N2] = ?acquire_nodes(2, Config), + ?match({ok, cp1, Ns}, mnesia:activate_checkpoint([{name, cp1},{max,mnesia:system_info(tables)}])), - Tab = tab, + Tab = tab, ?match({atomic, ok}, mnesia:create_table(Tab, [{disc_copies,Ns}])), OldRecs = [{Tab, K, -K} || K <- lists:seq(1, 5)], [mnesia:dirty_write(R) || R <- OldRecs], - + ?match({ok, cp2, Ns}, mnesia:activate_checkpoint([{name, cp2},{max,mnesia:system_info(tables)}])), File1 = "cp1_delete_me.BUP", ?match(ok, mnesia:dirty_write({Tab,6,-6})), @@ -742,16 +742,16 @@ sops_with_checkpoint(Config) when is_list(Config) -> ?match(ok, mnesia:dirty_write({Tab,7,-7})), File2 = "cp2_delete_me.BUP", ?match(ok, mnesia:backup_checkpoint(cp2, File2)), - + ?match(ok, mnesia:deactivate_checkpoint(cp1)), ?match(ok, mnesia:backup_checkpoint(cp2, File1)), ?match(ok, mnesia:dirty_write({Tab,8,-8})), - + ?match({atomic,ok}, mnesia:delete_table(Tab)), ?match({error,_}, mnesia:backup_checkpoint(cp2, File2)), ?match({'EXIT',_}, mnesia:dirty_write({Tab,9,-9})), - ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), + ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), Test = fun(N) when N > 5 -> ?error("To many records in backup ~p ~n", [N]); (N) -> case mnesia:dirty_read(Tab,N) of [{Tab,N,B}] when -B =:= N -> ok; @@ -759,8 +759,29 @@ sops_with_checkpoint(Config) when is_list(Config) -> end end, [Test(N) || N <- mnesia:dirty_all_keys(Tab)], - ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), - + ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), + + %% Mnesia crashes when deleting a table during backup + ?match([], mnesia_test_lib:stop_mnesia([N2])), + Tab2 = ram, + ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies,[N1]}])), + ?match({ok, cp3, _}, mnesia:activate_checkpoint([{name, cp3}, + {ram_overrides_dump,true}, + {min,[Tab2]}])), + Write = fun Loop (N) -> + case N > 0 of + true -> + mnesia:dirty_write({Tab2, N+100, N+100}), + Loop(N-1); + false -> + ok + end + end, + ok = Write(100000), + spawn_link(fun() -> ?match({atomic, ok},mnesia:delete_table(Tab2)) end), + + %% We don't check result here, depends on timing of above call + mnesia:backup_checkpoint(cp3, File2), file:delete(File1), file:delete(File2), - ?verify_mnesia(Ns, []). + ?verify_mnesia([N1], [N2]). diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 439b21e58c..e272a469bb 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.14.2 +MNESIA_VSN = 4.14.3 diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 0cea1fdcf0..200c728a62 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -58,7 +58,7 @@ binary_to_term_fun(Bin) -> try binary_to_term(Bin) of Term -> plain_html(io_lib:format("~p",[Term])) catch error:badarg -> - Warning = "This binary can not be coverted to an Erlang term", + Warning = "This binary can not be converted to an Erlang term", observer_html_lib:warning(Warning) end end. diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index 44f121f359..5782339183 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -55,7 +55,7 @@ init([Id, Data, ParentFrame, Callback, Parent]) -> end, {stop,normal}; {info,Info} -> - observer_lib:display_info_dialog(Info), + observer_lib:display_info_dialog(ParentFrame,Info), {stop,normal} end. diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 2f9f81104a..13e73f027d 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -928,7 +928,10 @@ general_info(File) -> WholeLine -> WholeLine end, - GI = get_general_info(Fd,#general_info{created=Created}), + {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]), + GI = get_general_info(Fd,#general_info{created=Created, + slogan=Slogan, + system_vsn=SysVsn}), {MemTot,MemMax} = case lookup_index(?memory) of @@ -982,12 +985,20 @@ general_info(File) -> mem_max=MemMax, instr_info=InstrInfo}. +get_slogan_and_sysvsn(Fd,Acc) -> + case val(Fd,eof) of + "Slogan: " ++ SloganPart when Acc==[] -> + get_slogan_and_sysvsn(Fd,[SloganPart]); + "System version: " ++ SystemVsn -> + {lists:append(lists:reverse(Acc)),SystemVsn}; + eof -> + {lists:append(lists:reverse(Acc)),"-1"}; + SloganPart -> + get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc]) + end. + get_general_info(Fd,GenInfo) -> case line_head(Fd) of - "Slogan" -> - get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)}); - "System version" -> - get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)}); "Compiled" -> get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)}); "Taints" -> diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl index fcb900960b..925f4456bb 100644 --- a/lib/observer/src/etop.erl +++ b/lib/observer/src/etop.erl @@ -23,7 +23,7 @@ -export([start/0, start/1, config/2, stop/0, dump/1, help/0]). %% Internal -export([update/1]). --export([loadinfo/1, meminfo/2, getopt/2]). +-export([loadinfo/2, meminfo/2, getopt/2]). -include("etop.hrl"). -include("etop_defs.hrl"). @@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"}); output(text) -> etop_txt. -loadinfo(SysI) -> +loadinfo(SysI,Prev) -> #etop_info{n_procs = Procs, run_queue = RQ, now = Now, wall_clock = WC, runtime = RT} = SysI, - Cpu = calculate_cpu_utilization(WC,RT), + Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime), Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", tuple_to_list(element(2,calendar:now_to_datetime(Now)))), {Cpu,Procs,RQ,Clock}. -calculate_cpu_utilization({_,WC},{_,RT}) -> +calculate_cpu_utilization({_,WC},{_,RT},_) -> %% Old version of observer_backend, using statistics(wall_clock) %% and statistics(runtime) case {WC,RT} of @@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) -> _ -> round(100*RT/WC) end; -calculate_cpu_utilization(_,undefined) -> +calculate_cpu_utilization(_,undefined,_) -> %% First time collecting - no cpu utilization has been measured %% since scheduler_wall_time flag is not yet on 0; -calculate_cpu_utilization(_,RTInfo) -> +calculate_cpu_utilization(WC,RTInfo,undefined) -> + %% Second time collecting - RTInfo shows scheduler_wall_time since + %% flag was set to true. Faking previous values by setting + %% everything to zero. + ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo], + calculate_cpu_utilization(WC,RTInfo,ZeroRT); +calculate_cpu_utilization(_,RTInfo,PrevRTInfo) -> %% New version of observer_backend, using statistics(scheduler_wall_time) - Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end, + Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) -> + {(A1 - A0)+AAcc,(T1 - T0)+TAcc} + end, {0,0}, - RTInfo), + lists:zip(PrevRTInfo,RTInfo)), case Sum of {0,0} -> 0; diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl index 3b4c176478..6b8f9df24f 100644 --- a/lib/observer/src/etop_txt.erl +++ b/lib/observer/src/etop_txt.erl @@ -22,35 +22,35 @@ %%-compile(export_all). -export([init/1,stop/1]). --export([do_update/3]). +-export([do_update/4]). -include("etop.hrl"). -include("etop_defs.hrl"). --import(etop,[loadinfo/1,meminfo/2]). +-import(etop,[loadinfo/2,meminfo/2]). -define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n"). stop(Pid) -> Pid ! stop. init(Config) -> - loop(Config). + loop(#etop_info{},Config). -loop(Config) -> - Info = do_update(Config), +loop(Prev,Config) -> + Info = do_update(Prev,Config), receive stop -> stopped; - {dump,Fd} -> do_update(Fd,Info,Config), loop(Config); - {config,_,Config1} -> loop(Config1) - after Config#opts.intv -> loop(Config) + {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config); + {config,_,Config1} -> loop(Info,Config1) + after Config#opts.intv -> loop(Info,Config) end. -do_update(Config) -> +do_update(Prev,Config) -> Info = etop:update(Config), - do_update(standard_io,Info,Config). + do_update(standard_io,Info,Prev,Config). -do_update(Fd,Info,Config) -> - {Cpu,NProcs,RQ,Clock} = loadinfo(Info), +do_update(Fd,Info,Prev,Config) -> + {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev), io:nl(Fd), writedoubleline(Fd), case Info#etop_info.memi of diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index 936b2783e2..80a41fdde9 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -191,8 +191,8 @@ handle_event(#wx{event=#wxMouse{type=Type, x=X0, y=Y0}}, end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, - State = #state{sel=undefined}) -> - observer_lib:display_info_dialog("Select process first"), + State = #state{panel=Panel,sel=undefined}) -> + observer_lib:display_info_dialog(Panel,"Select process first"), {noreply, State}; handle_event(#wx{id=?ID_PROC_INFO, event=#wxCommand{type=command_menu_selected}}, @@ -205,7 +205,7 @@ handle_event(#wx{id=?ID_PROC_MSG, event=#wxCommand{type=command_menu_selected}}, case observer_lib:user_term(Panel, "Enter message", "") of cancel -> ok; {ok, Term} -> Pid ! Term; - {error, Error} -> observer_lib:display_info_dialog(Error) + {error, Error} -> observer_lib:display_info_dialog(Panel,Error) end, {noreply, State}; @@ -214,7 +214,7 @@ handle_event(#wx{id=?ID_PROC_KILL, event=#wxCommand{type=command_menu_selected}} case observer_lib:user_term(Panel, "Enter Exit Reason", "kill") of cancel -> ok; {ok, Term} -> exit(Pid, Term); - {error, Error} -> observer_lib:display_info_dialog(Error) + {error, Error} -> observer_lib:display_info_dialog(Panel,Error) end, {noreply, State}; diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 59a2f9f205..47844c1307 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -20,7 +20,7 @@ -module(observer_lib). -export([get_wx_parent/1, - display_info_dialog/1, display_yes_no_dialog/1, + display_info_dialog/2, display_yes_no_dialog/1, display_progress_dialog/2, destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, @@ -105,10 +105,10 @@ setup_timer(Bool, {Timer, Old}) -> timer:cancel(Timer), setup_timer(Bool, {false, Old}). -display_info_dialog(Str) -> - display_info_dialog("",Str). -display_info_dialog(Title,Str) -> - Dlg = wxMessageDialog:new(wx:null(), Str, [{caption,Title}]), +display_info_dialog(Parent,Str) -> + display_info_dialog(Parent,"",Str). +display_info_dialog(Parent,Title,Str) -> + Dlg = wxMessageDialog:new(Parent, Str, [{caption,Title}]), wxMessageDialog:showModal(Dlg), wxMessageDialog:destroy(Dlg), ok. @@ -461,14 +461,16 @@ create_box(Parent, Data) -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - case length(Value) > 100 of - true -> - Shown = lists:sublist(Value, 80), + case string:sub_word(lists:sublist(Value, 80),1,$\n) of + Value -> + %% Short string, no newlines - show all + wxStaticText:new(Panel, ?wxID_ANY, Value); + Shown -> + %% Long or with newlines, + %% use tooltip to show all TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]), wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), - TCtrl; - false -> - wxStaticText:new(Panel, ?wxID_ANY, Value) + TCtrl end end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally @@ -722,7 +724,7 @@ progress_loop(Title,PD,Caller) -> if is_list(Reason) -> Reason; true -> file:format_error(Reason) end, - display_info_dialog("Crashdump Viewer Error",FailMsg), + display_info_dialog(PD,"Crashdump Viewer Error",FailMsg), Caller ! error, unregister(?progress_handler), unlink(Caller); diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 53ba3fa607..c21d2705c0 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -267,10 +267,19 @@ handle_cast(Event, _State) -> error({unhandled_cast, Event}). handle_info({portinfo_open, PortIdStr}, - State = #state{grid=Grid, ports=Ports, open_wins=Opened}) -> - Port = lists:keyfind(PortIdStr,#port.id_str,Ports), - NewOpened = display_port_info(Grid, Port, Opened), - {noreply, State#state{open_wins = NewOpened}}; + State = #state{node=Node, grid=Grid, opt=Opt, open_wins=Opened}) -> + Ports0 = get_ports(Node), + Ports = update_grid(Grid, Opt, Ports0), + Port = lists:keyfind(PortIdStr, #port.id_str, Ports), + NewOpened = + case Port of + false -> + self() ! {error,"No such port: " ++ PortIdStr}, + Opened; + _ -> + display_port_info(Grid, Port, Opened) + end, + {noreply, State#state{ports=Ports, open_wins=NewOpened}}; handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, ports=OldPorts}) -> @@ -296,8 +305,9 @@ handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, State) -> - handle_error(Error), +handle_info({error, Error}, #state{panel=Panel} = State) -> + Str = io_lib:format("ERROR: ~s~n",[Error]), + observer_lib:display_info_dialog(Panel, Str), {noreply, State}; handle_info(_Event, State) -> @@ -501,11 +511,6 @@ filter_monitor_info() -> [Pid || {process, Pid} <- Ms] end. - -handle_error(Foo) -> - Str = io_lib:format("ERROR: ~s~n",[Foo]), - observer_lib:display_info_dialog(Str). - update_grid(Grid, Opt, Ports) -> wx:batch(fun() -> update_grid2(Grid, Opt, Ports) end). update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ee6829b847..f07b9e295a 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs, table_holder(S0); {dump, Fd} -> EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}), + %% The empty #etop_info{} below is a dummy previous info + %% value. It is used by etop to calculate the scheduler + %% utilization since last update. When dumping to file, + %% there is no previous measurement to use, so we just add + %% a dummy here, and the value shown will be since the + %% tool was started. + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), file:close(Fd), table_holder(S0); stop -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index c13b164ff9..21eb9facc5 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -92,7 +92,7 @@ init([Pid, ParentFrame, Parent]) -> observer_wx:return_to_localnode(ParentFrame, node(Pid)), {stop, badrpc}; process_undefined -> - observer_lib:display_info_dialog("No such alive process"), + observer_lib:display_info_dialog(ParentFrame,"No such alive process"), {stop, normal} end. diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index 968a7620aa..4356cb890c 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -238,8 +238,9 @@ handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, #state{opt=Opt}=State) -> - handle_error(Error), +handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> + Str = io_lib:format("ERROR: ~s~n",[Error]), + observer_lib:display_info_dialog(Panel,Str), case Opt#opt.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); _ -> ok @@ -365,10 +366,6 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -handle_error(Foo) -> - Str = io_lib:format("ERROR: ~s~n",[Foo]), - observer_lib:display_info_dialog(Str). - update_grid(Grid, Opt, Tables) -> wx:batch(fun() -> update_grid2(Grid, Opt, Tables) end). update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 5732c12006..83de4fa64c 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -467,10 +467,10 @@ handle_info(_Info, State) -> stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs, trace_panel=Trace, app_panel=Apps, perf_panel=Perfs, - allc_panel=Alloc} = _State) -> + allc_panel=Alloc, port_panel=Ports} = _State) -> LogOn andalso rpc:block_call(Node, rb, stop, []), Me = self(), - Tabs = [Sys, Procs, TVs, Trace, Apps, Perfs, Alloc], + Tabs = [Sys, Procs, Ports, TVs, Trace, Apps, Perfs, Alloc], Stop = fun() -> try _ = [wx_object:stop(Panel) || Panel <- Tabs], @@ -580,9 +580,10 @@ get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys, pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf, allc_panel=Alloc}) -> + perf_panel=Perf, allc_panel=Alloc, port_panel=Port}) -> case Pid of Pro -> "Processes"; + Port -> "Ports"; Sys -> "System"; Tv -> "Table Viewer" ; Trace -> ?TRACE_STR; @@ -635,7 +636,8 @@ create_connect_dialog(connect, #state{frame = Frame}) -> wxWindow:setSizerAndFit(Dialog, VSizer), wxSizer:setSizeHints(VSizer, Dialog), - CookiePath = filename:join(os:getenv("HOME"), ".erlang.cookie"), + {ok,[[HomeDir]]} = init:get_argument(home), + CookiePath = filename:join(HomeDir, ".erlang.cookie"), DefaultCookie = case filelib:is_file(CookiePath) of true -> {ok, Bin} = file:read_file(CookiePath), diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 4c882ad951..b5fb027878 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -34,7 +34,8 @@ %% Test cases -export([app_file/1, appup_file/1, - basic/1, process_win/1, table_win/1 + basic/1, process_win/1, table_win/1, + port_win_when_tab_not_initiated/1 ]). %% Default timetrap timeout (set in init_per_testcase) @@ -49,7 +50,8 @@ groups() -> [{gui, [], [basic, process_win, - table_win + table_win, + port_win_when_tab_not_initiated ] }]. @@ -299,6 +301,17 @@ table_win(Config) when is_list(Config) -> observer:stop(), ok. +%% Test PR-1296/OTP-14151 +%% Clicking a link to a port before the port tab has been activated the +%% first time crashes observer. +port_win_when_tab_not_initiated(Config) -> + {ok,Port} = gen_tcp:listen(0,[]), + ok = observer:start(), + Notebook = setup_whitebox_testing(), + observer ! {open_link,erlang:port_to_list(Port)}, + timer:sleep(1000), + observer:stop(), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 4729d090f8..0a9a883390 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -701,6 +701,7 @@ get_os_wordsize_with_uname() -> "sparc64" -> 64; "amd64" -> 64; "ppc64" -> 64; + "s390x" -> 64; _ -> 32 end. diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index c503230d70..c97ec361d1 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -757,6 +757,39 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, </func> <func> + <name>pkix_verify_hostname(Cert, ReferenceIDs) -> boolean()</name> + <name>pkix_verify_hostname(Cert, ReferenceIDs, Opts) -> boolean()</name> + <fsummary>Verifies that a PKIX x.509 certificate <i>presented identifier</i> (e.g hostname) is + an expected one.</fsummary> + <type> + <v>Cert = der_encoded() | #'OTPCertificate'{} </v> + <v>ReferenceIDs = [ RefID ]</v> + <v>RefID = {IdType,string()}</v> + <v>IdType = dns_id | srv_id | uri_id</v> + <v>Opts = [ PvhOpt() ]</v> + <v>PvhOpt = [MatchOpt | FailCallBackOpt | FqdnExtractOpt]</v> + <v>MatchOpt = {fun(RefId | FQDN::string(), PresentedID) -> boolean() | default}</v> + <v>PresentedID = {dNSName,string()} | {uniformResourceIdentifier,string()}</v> + <v>FailCallBackOpt = {fail_callback, fun(#'OTPCertificate'{}) -> boolean()}</v> + <v>FqdnExtractOpt = {fqdn_fun, fun(RefID) -> FQDN::string() | default | undefined}</v> + </type> + <desc> + <p>This function checks that the <i>Presented Identifier</i> (e.g hostname) in a peer certificate + conforms with the Expected Identifier that the client wants to connect to. + This functions is intended to be added as an extra client check to the peer certificate when performing + <seealso marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> + </p> + <p>See <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> + for detailed information about hostname verification. + The <seealso marker="using_public_key#verify_hostname">User's Manual</seealso> + and + <seealso marker="using_public_key#verify_hostname_examples">code examples</seealso> + describes this function more detailed. + </p> + </desc> + </func> + + <func> <name>sign(Msg, DigestType, Key) -> binary()</name> <fsummary>Creates a digital signature.</fsummary> <type> @@ -824,6 +857,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <func> <name>ssh_hostkey_fingerprint(HostKey) -> string()</name> <name>ssh_hostkey_fingerprint(DigestType, HostKey) -> string()</name> + <name>ssh_hostkey_fingerprint([DigestType], HostKey) -> [string()]</name> <fsummary>Calculates a ssh fingerprint for a hostkey.</fsummary> <type> <v>Key = public_key()</v> @@ -847,6 +881,10 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, 5> public_key:ssh_hostkey_fingerprint(sha256,Key). "SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ" + + 6> public_key:ssh_hostkey_fingerprint([sha,sha256],Key). + ["SHA1:bSLY/C4QXLDL/Iwmhyg0PGW9UbY", + "SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ"] </code> </desc> </func> diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index e3a1eed4be..417d479da3 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -417,6 +417,259 @@ true = public_key:verify(Digest, none, Signature, PublicKey),</code> </section> + <section> + <marker id="verify_hostname"></marker> + <title>Verifying a certificate hostname</title> + <section> + <title>Background</title> + <p>When a client checks a server certificate there are a number of checks available like + checks that the certificate is not revoked, not forged or not out-of-date. + </p> + <p>There are however attacks that are not detected by those checks. Suppose a bad guy has + succeded with a DNS infection. Then the client could belive it is connecting to one host but + ends up at another but evil one. Though it is evil, it could have a perfectly legal + certificate! The certificate has a valid signature, it is not revoked, the certificate chain + is not faked and has a trusted root and so on. + </p> + <p>To detect that the server is not the intended one, the client must additionaly perform + a <i>hostname verification</i>. This procedure is described in + <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>. The idea is that the certificate + lists the hostnames it could be fetched from. This is checked by the certificate issuer when + the certificate is signed. So if the certificate is issued by a trusted root the client + could trust the host names signed in it. + </p> + <p>There is a default hostname matching procedure defined in + <url href="https://tools.ietf.org/html/rfc6125#section-6">RFC 6125, section 6</url> + as well as protocol dependent variations defined in + <url href="https://tools.ietf.org/html/rfc6125#appendix-B">RFC 6125 appendix B</url>. + The default procedure is implemented in + <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2,3</seealso>. + It is possible for a client to hook in modified rules using the options list. + </p> + <p>Some terminology is needed: the certificate presents hostname(s) on which it is valid. + Those are called <i>Presented IDs</i>. The hostname(s) the client belives it connects to + are called <i>Reference IDs</i>. The matching rules aims to verify that there is at least + one of the Reference IDs that matches one of the Presented IDs. If not, the verification fails. + </p> + <p>The IDs contains normal fully qualified domain names like e.g <c>foo.example.com</c>, + but IP addresses are not recommended. The rfc describes why this is not recommended as well + as security considerations about how to aquire the Reference IDs. + </p> + <p>Internationalized domain names are not supported. + </p> + </section> + <section> + <title>The verification process</title> + <p>Traditionally the Presented IDs were found in the <c>Subject</c> certificate field as <c>CN</c> + names. This is still quite common. When printing a certificate they show up as: + </p> + <code> + $ openssl x509 -text < cert.pem + ... + Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org + ... + </code> + <p>The example <c>Subject</c> field has one C, two CN and one O part. It is only the + CN (Common Name) that is used by hostname verification. The two other (C and O) is not used + here even when they contain a domain name like the O part. The C and O parts are defined + elsewhere and meaningful only for other functions. + </p> + <p>In the example the Presented IDs are <c>example.com</c> as well as hostnames matching + <c>*.example.com</c>. For example <c>foo.example.com</c> and <c>bar.example.com</c> both + matches but not <c>foo.bar.example.com</c>. The name <c>erlang.org</c> matches neither + since it is not a CN. + </p> + <p>In case where the Presented IDs are fetched from the <c>Subject</c> certificate field, the + names may contain wildcard characters. The function handles this as defined in + <url href="https://tools.ietf.org/html/rfc6125#section-6.4.3">chapter 6.4.3 in RFC 6125</url>. + </p> + <p>There may only be one wildcard character and that is in the first label, for example: + <c>*.example.com</c>. This matches <c>foo.example.com</c> but neither <c>example.com</c> nor + <c>foo.bar.example.com</c>. + </p> + <p>There may be label characters before or/and after the wildcard. For example: + <c>a*d.example.com</c> matches <c>abcd.example.com</c> and <c>ad.example.com</c>, + but not <c>ab.cd.example.com</c>. + </p> + <p>In the previous example there is no indication of which protocols are expected. So a client + has no indication of whether it is a web server, an ldap server or maybe a sip server it is + connected to. + There are fields in the certificate that can indicate this. To be more exact, the rfc + introduces the usage of the <c>X509v3 Subject Alternative Name</c> in the <c>X509v3 extensions</c> + field: + </p> + <code> + $ openssl x509 -text < cert.pem + ... + X509v3 extensions: + X509v3 Subject Alternative Name: + DNS:kb.example.org, URI:https://www.example.org + ... + </code> + <p>Here <c>kb.example.org</c> serves any protocol while <c>www.example.org</c> presents a secure + web server. + </p> + + <p>The next example has both <c>Subject</c> and <c>Subject Alternate Name</c> present:</p> + <code> + $ openssl x509 -text < cert.pem + ... + Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org + ... + X509v3 extensions: + X509v3 Subject Alternative Name: + DNS:kb.example.org, URI:https://www.example.org + ... + </code> + <p>The RFC states that if a certificate defines Reference IDs in a <c>Subject Alternate Name</c> + field, the <c>Subject</c> field MUST NOT be used for host name checking, even if it contains + valid CN names. + Therefore only <c>kb.example.org</c> and <c>https://www.example.org</c> matches. The match fails + both for <c>example.com</c> and <c>foo.example.com</c> becuase they are in the <c>Subject</c> + field which is not checked because the <c>Subject Alternate Name</c> field is present. + </p> + </section> + + <section> + <marker id="verify_hostname_examples"></marker> + <title>Function call examples</title> + <note> + <p>Other applications like ssl/tls or https might have options that are passed + down to the <c>public_key:pkix_verify_hostname</c>. You will probably not + have to call it directly</p> + </note> + <p>Suppose our client expects to connect to the web server https://www.example.net. This + URI is therefore the Reference IDs of the client. + The call will be: + </p> + <code> + public_key:pkix_verify_hostname(CertFromHost, + [{uri_id, "https://www.example.net"} + ]). + </code> + <p>The call will return <c>true</c> or <c>false</c> depending on the check. The caller + do not need to handle the matching rules in the rfc. The matching will proceed as: + </p> + <list> + <item>If there is a <c>Subject Alternate Name</c> field, the <c>{uri_id,string()}</c> in the + function call will be compared to any + <c>{uniformResourceIdentifier,string()}</c> in the Certificate field. + If the two <c>strings()</c> are equal (case insensitive), there is a match. + The same applies for any <c>{dns_id,string()}</c> in the call which is compared + with all <c>{dNSName,string()}</c> in the Certificate field. + </item> + <item>If there is NO <c>Subject Alternate Name</c> field, the <c>Subject</c> field will be + checked. All <c>CN</c> names will be compared to all hostnames <i>extracted</i> from + <c>{uri_id,string()}</c> and from <c>{dns_id,string()}</c>. + </item> + </list> + </section> + <section> + <title>Extending the search mechanism</title> + <p>The caller can use own extraction and matching rules. This is done with the two options + <c>fqdn_fun</c> and <c>match_fun</c>. + </p> + <section> + <title>Hostname extraction</title> + <p>The <c>fqdn_fun</c> extracts hostnames (Fully Qualified Domain Names) from uri_id + or other ReferenceIDs that are not pre-defined in the public_key function. + Suppose you have some URI with a very special protocol-part: + <c>myspecial://example.com"</c>. Since this a non-standard URI there will be no hostname + extracted for matching CN-names in the <c>Subject</c>.</p> + <p>To "teach" the function how to extract, you can give a fun which replaces the default + extraction function. + The <c>fqdn_fun</c> takes one argument and returns + either a <c>string()</c> to be matched to each CN-name or the atom <c>default</c> which will invoke + the default fqdn extraction function. The return value <c>undefined</c> removes the current + URI from the fqdn extraction. + </p> + <code> + ... + Extract = fun({uri_id, "myspecial://"++HostName}) -> HostName; + (_Else) -> default + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{fqdn_fun, Extract}]) + ... + </code> + </section> + <section> + <title>Re-defining the match operations</title> + <p>The default matching handles dns_id and uri_id. In an uri_id the value is tested for + equality with a value from the <c>Subject Alternate Name</c>. If som other kind of matching + is needed, use the <c>match_fun</c> option. + </p> + <p>The <c>match_fun</c> takes two arguments and returns either <c>true</c>, + <c>false</c> or <c>default</c>. The value <c>default</c> will invoke the default + match function. + </p> + <code> + ... + Match = fun({uri_id,"myspecial://"++A}, + {uniformResourceIdentifier,"myspecial://"++B}) -> + my_match(A,B); + (_RefID, _PresentedID) -> + default + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{match_fun, Match}]), + ... + </code> + <p>In case of a match operation between a ReferenceID and a CN value from the <c>Subject</c> + field, the first argument to the fun is the extracted hostname from the ReferenceID, and the + second argument is the tuple <c>{cn, string()}</c> taken from the <c>Subject</c> field. That + makes it possible to have separate matching rules for Presented IDs from the <c>Subject</c> + field and from the <c>Subject Alternate Name</c> field. + </p> + <p>The default matching transformes the ascii values in strings to lowercase before comparing. + The <c>match_fun</c> is however called without any transfomation applied to the strings. The + reason is to enable the user to do unforseen handling of the strings where the original format + is needed. + </p> + </section> + </section> + <section> + <title>"Pinning" a Certificate</title> + <p>The <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> defines <i>pinning</i> + as:</p> + <quote> + <p>"The act of establishing a cached name association between + the application service's certificate and one of the client's + reference identifiers, despite the fact that none of the presented + identifiers matches the given reference identifier. ..." + </p> + </quote> + <p>The purpose is to have a mechanism for a human to accept an otherwise faulty Certificate. + In for example a web browser, you could get a question like </p> + <quote> + <p>Warning: you wanted to visit the site www.example.com, + but the certificate is for shop.example.com. Accept anyway (yes/no)?" + </p> + </quote> + <p>This could be accomplished with the option <c>fail_callback</c> which will + be called if the hostname verification fails: + </p> + <code> + -include_lib("public_key/include/public_key.hrl"). % Record def + ... + Fail = fun(#'OTPCertificate'{}=C) -> + case in_my_cache(C) orelse my_accept(C) of + true -> + enter_my_cache(C), + true; + false -> + false + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{fail_callback, Fail}]), + ... + </code> + </section> + </section> + <section> <title>SSH Files</title> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 05c09f8996..adc35073d6 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -48,6 +48,7 @@ pkix_issuer_id/2, pkix_normalize_name/1, pkix_path_validation/3, + pkix_verify_hostname/2, pkix_verify_hostname/3, ssh_decode/2, ssh_encode/2, ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2, ssh_curvename2oid/1, oid2ssh_curvename/1, @@ -763,6 +764,76 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, Options, pubkey_crl:init_revokation_state()). +%-------------------------------------------------------------------- +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}]) -> boolean(). + +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}], + Options :: proplists:proplist()) -> boolean(). + +%% Description: Validates a hostname to RFC 6125 +%%-------------------------------------------------------------------- +pkix_verify_hostname(Cert, ReferenceIDs) -> + pkix_verify_hostname(Cert, ReferenceIDs, []). + +pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) -> + pkix_verify_hostname(pkix_decode_cert(BinCert,otp), ReferenceIDs, Options); + +pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) -> + MatchFun = proplists:get_value(match_fun, Opts, undefined), + FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end), + FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1), + + ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0], + PresentedIDs = + try lists:keyfind(?'id-ce-subjectAltName', + #'Extension'.extnID, + TbsCert#'OTPTBSCertificate'.extensions) + of + #'Extension'{extnValue = ExtVals} -> + [{T,to_string(V)} || {T,V} <- ExtVals]; + false -> + [] + catch + _:_ -> [] + end, + %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]} + case PresentedIDs of + [] -> + %% Fallback to CN-ids [rfc6125, ch6] + case TbsCert#'OTPTBSCertificate'.subject of + {rdnSequence,RDNseq} -> + PresentedCNs = + [{cn, to_string(V)} + || ATVs <- RDNseq, % RDNseq is list-of-lists + #'AttributeTypeAndValue'{type = ?'id-at-commonName', + value = {_T,V}} <- ATVs + % _T = kind of string (teletexString etc) + ], + %% Example of PresentedCNs: [{cn,"www.ericsson.se"}] + %% match ReferenceIDs to PresentedCNs + verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun), + PresentedCNs, + MatchFun, FailCB, Cert); + + _ -> + false + end; + _ -> + %% match ReferenceIDs to PresentedIDs + case verify_hostname_match_loop(ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert) of + false -> + %% Try to extract DNS-IDs from URIs etc + DNS_ReferenceIDs = + [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)], + verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert); + true -> + true + end + end. %%-------------------------------------------------------------------- -spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}] @@ -822,21 +893,31 @@ oid2ssh_curvename(?'secp521r1') -> <<"nistp521">>. %%-------------------------------------------------------------------- -spec ssh_hostkey_fingerprint(public_key()) -> string(). --spec ssh_hostkey_fingerprint(digest_type(), public_key()) -> string(). +-spec ssh_hostkey_fingerprint( digest_type(), public_key()) -> string() + ; ([digest_type()], public_key()) -> [string()] + . ssh_hostkey_fingerprint(Key) -> - sshfp_string(md5, Key). + sshfp_string(md5, public_key:ssh_encode(Key,ssh2_pubkey) ). -ssh_hostkey_fingerprint(HashAlg, Key) -> - lists:concat([sshfp_alg_name(HashAlg), - [$: | sshfp_string(HashAlg, Key)] - ]). +ssh_hostkey_fingerprint(HashAlgs, Key) when is_list(HashAlgs) -> + EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + [sshfp_full_string(HashAlg,EncKey) || HashAlg <- HashAlgs]; +ssh_hostkey_fingerprint(HashAlg, Key) when is_atom(HashAlg) -> + EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + sshfp_full_string(HashAlg, EncKey). -sshfp_string(HashAlg, Key) -> + +sshfp_string(HashAlg, EncodedKey) -> %% Other HashAlgs than md5 will be printed with %% other formats than hextstr by %% ssh-keygen -E <alg> -lf <file> - fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, public_key:ssh_encode(Key,ssh2_pubkey))). + fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, EncodedKey)). + +sshfp_full_string(HashAlg, EncKey) -> + lists:concat([sshfp_alg_name(HashAlg), + [$: | sshfp_string(HashAlg, EncKey)] + ]). sshfp_alg_name(sha) -> "SHA1"; sshfp_alg_name(Alg) -> string:to_upper(atom_to_list(Alg)). @@ -1200,3 +1281,96 @@ ascii_to_lower(String) -> end)>> || <<C>> <= iolist_to_binary(String) >>. + +%%%---------------------------------------------------------------- +%%% pkix_verify_hostname help functions +verify_hostname_extract_fqdn_default({dns_id,S}) -> + S; +verify_hostname_extract_fqdn_default({uri_id,URI}) -> + {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI), + Host. + + +verify_hostname_fqnds(L, FqdnFun) -> + [E || E0 <- L, + E <- [try case FqdnFun(E0) of + default -> verify_hostname_extract_fqdn_default(E0); + undefined -> undefined; % will make the "is_list(E)" test fail + Other -> Other + end + catch _:_-> undefined % will make the "is_list(E)" test fail + end], + is_list(E), + E =/= "", + {error,einval} == inet:parse_address(E) + ]. + + +-define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}). + +verify_hostname_match_default(Ref, Pres) -> + verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)). + +verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) -> + not lists:member($*, FQDN); +verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) -> + [F1|Fs] = string:tokens(FQDN, "."), + [N1|Ns] = string:tokens(Name, "."), + match_wild(F1,N1) andalso Fs==Ns; +verify_hostname_match_default0({dns_id,R}, {dNSName,P}) -> + R==P; +verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) -> + R==P; +verify_hostname_match_default0({srv_id,R}, {T,P}) when T == srvName ; + T == ?srvName_OID -> + R==P; +verify_hostname_match_default0(_, _) -> + false. + + +match_wild(A, [$*|B]) -> match_wild_suffixes(A, B); +match_wild([C|A], [ C|B]) -> match_wild(A, B); +match_wild([], []) -> true; +match_wild(_, _) -> false. + +%% Match the parts after the only wildcard by comparing them from the end +match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)). + +match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards alowed) +match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards alowed) +match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br); +match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards) +match_wild_sfx(_, _) -> false. + + +verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) -> + Pres = lists:map(fun to_lower_ascii/1, Pres0), + Refs = lists:map(fun to_lower_ascii/1, Refs0), + lists:any( + fun(R) -> + lists:any(fun(P) -> + verify_hostname_match_default(R,P) orelse FailCB(Cert) + end, Pres) + end, Refs); +verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) -> + lists:any( + fun(R) -> + lists:any(fun(P) -> + (case MatchFun(R,P) of + default -> verify_hostname_match_default(R,P); + Bool -> Bool + end) orelse FailCB(Cert) + end, + Pres) + end, + Refs). + + +to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S); +to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)}; +to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A); +to_lower_ascii(C) -> C. + +to_string(S) when is_list(S) -> S; +to_string(B) when is_binary(B) -> binary_to_list(B). + diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index cd24819899..68aa152911 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -45,13 +45,17 @@ all() -> {group, sign_verify}, pkix, pkix_countryname, pkix_emailaddress, pkix_path_validation, pkix_iso_rsa_oid, pkix_iso_dsa_oid, pkix_crl, general_name, + pkix_verify_hostname_cn, + pkix_verify_hostname_subjAltName, + pkix_verify_hostname_options, short_cert_issuer_hash, short_crl_issuer_hash, ssh_hostkey_fingerprint_md5_implicit, ssh_hostkey_fingerprint_md5, ssh_hostkey_fingerprint_sha, ssh_hostkey_fingerprint_sha256, ssh_hostkey_fingerprint_sha384, - ssh_hostkey_fingerprint_sha512 + ssh_hostkey_fingerprint_sha512, + ssh_hostkey_fingerprint_list ]. groups() -> @@ -90,20 +94,21 @@ end_per_group(_GroupName, Config) -> %%------------------------------------------------------------------- init_per_testcase(TestCase, Config) -> case TestCase of - ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase(md5, Config); - ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase(md5, Config); - ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase(sha, Config); - ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase(sha256, Config); - ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase(sha384, Config); - ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase(sha512, Config); + ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase([md5], Config); + ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase([md5], Config); + ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase([sha], Config); + ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase([sha256], Config); + ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase([sha384], Config); + ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase([sha512], Config); + ssh_hostkey_fingerprint_list -> init_fingerprint_testcase([sha,md5], Config); _ -> init_common_per_testcase(Config) end. -init_fingerprint_testcase(Alg, Config) -> - CryptoSupports = lists:member(Alg, proplists:get_value(hashs, crypto:supports())), - case CryptoSupports of - false -> {skip,{Alg,not_supported}}; - true -> init_common_per_testcase(Config) +init_fingerprint_testcase(Algs, Config) -> + Hashs = proplists:get_value(hashs, crypto:supports(), []), + case Algs -- Hashs of + [] -> init_common_per_testcase(Config); + UnsupportedAlgs -> {skip,{UnsupportedAlgs,not_supported}} end. init_common_per_testcase(Config0) -> @@ -597,6 +602,14 @@ ssh_hostkey_fingerprint_sha512(_Config) -> Expected = public_key:ssh_hostkey_fingerprint(sha512, ssh_hostkey(rsa)). %%-------------------------------------------------------------------- +%% Since this kind of fingerprint is not available yet on standard +%% distros, we do like this instead. +ssh_hostkey_fingerprint_list(_Config) -> + Expected = ["SHA1:Soammnaqg06jrm2jivMSnzQGlmk", + "MD5:4b:0b:63:de:0f:a7:3a:ab:2c:cc:2d:d1:21:37:1d:3a"], + Expected = public_key:ssh_hostkey_fingerprint([sha,md5], ssh_hostkey(rsa)). + +%%-------------------------------------------------------------------- encrypt_decrypt() -> [{doc, "Test public_key:encrypt_private and public_key:decrypt_public"}]. encrypt_decrypt(Config) when is_list(Config) -> @@ -814,6 +827,114 @@ pkix_path_validation(Config) when is_list(Config) -> ok. %%-------------------------------------------------------------------- +%% To generate the PEM file contents: +%% +%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -subj '/C=SE/CN=example.com/CN=*.foo.example.com/CN=a*b.bar.example.com/O=erlang.org' > public_key_SUITE_data/pkix_verify_hostname_cn.pem +%% +%% Note that the same pem-file is used in pkix_verify_hostname_options/1 +%% +%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org +%% extensions = no subjAltName + +pkix_verify_hostname_cn(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that 1) only CNs are checked, + %% 2) an empty label does not match a wildcard and + %% 3) a wildcard does not match more than one label + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}, + {dns_id,"foo.EXAMPLE.com"}, + {dns_id,"b.a.foo.EXAMPLE.com"}]), + + %% Check that a hostname is extracted from a https-uri and used for checking: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"HTTPS://EXAMPLE.com"}]), + + %% Check wildcard matching one label: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"a.foo.EXAMPLE.com"}]), + + %% Check wildcard with surrounding chars matches one label: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"accb.bar.EXAMPLE.com"}]), + + %% Check that a wildcard with surrounding chars matches an empty string: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://ab.bar.EXAMPLE.com"}]). + +%%-------------------------------------------------------------------- +%% To generate the PEM file contents: +%% +%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -extensions SAN -config public_key_SUITE_data/verify_hostname.conf 2>/dev/null > public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem +%% +%% Subject: C=SE, CN=example.com +%% Subject Alternative Name: DNS:kb.example.org, URI:http://www.example.org, URI:https://wws.example.org + +pkix_verify_hostname_subjAltName(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_subjAltName.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that neither a uri nor dns hostname matches a CN if subjAltName is present: + false = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}, + {dns_id,"example.com"}]), + + %% Check that a uri_id matches a URI subjAltName: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://wws.example.org"}]), + + %% Check that a dns_id does not match a URI subjAltName: + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"www.example.org"}, + {dns_id,"wws.example.org"}]), + + %% Check that a dns_id matches a DNS subjAltName: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"kb.example.org"}]). + +%%-------------------------------------------------------------------- +%% Uses the pem-file for pkix_verify_hostname_cn +%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org +pkix_verify_hostname_options(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that the fail_callback is called and is presented the correct certificate: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}], + [{fail_callback, + fun(#'OTPCertificate'{}=C) when C==Cert -> + true; % To test the return value matters + (#'OTPCertificate'{}=C) -> + ct:log("~p:~p: Wrong cert:~n~p~nExpect~n~p", + [?MODULE, ?LINE, C, Cert]), + ct:fail("Wrong cert, see log"); + (C) -> + ct:log("~p:~p: Bad cert: ~p",[?MODULE,?LINE,C]), + ct:fail("Bad cert, see log") + end}]), + + %% Check the callback for user-provided match functions: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"very.wrong.domain"}], + [{match_fun, + fun("very.wrong.domain", {cn,"example.com"}) -> + true; + (_, _) -> + false + end}]), + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"not.example.com"}], + [{match_fun, fun(_, _) -> default end}]), + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"example.com"}], + [{match_fun, fun(_, _) -> default end}]), + + %% Check the callback for user-provided fqdn extraction: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}], + [{fqdn_fun, + fun({uri_id, "some://very.wrong.domain"}) -> + "example.com"; + (_) -> + "" + end}]), + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}], + [{fqdn_fun, fun(_) -> default end}]), + false = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}]). + +%%-------------------------------------------------------------------- pkix_iso_rsa_oid() -> [{doc, "Test workaround for supporting certs that use ISO oids" " 1.3.14.3.2.29 instead of PKIX/PKCS oid"}]. diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem new file mode 100644 index 0000000000..9f7b428f9a --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICsjCCAhugAwIBAgIJAMCGx1ezaJFRMA0GCSqGSIb3DQEBCwUAMHIxCzAJBgNV +BAYTAlNFMRQwEgYDVQQDDAtleGFtcGxlLmNvbTEaMBgGA1UEAwwRKi5mb28uZXhh +bXBsZS5jb20xHDAaBgNVBAMME2EqYi5iYXIuZXhhbXBsZS5jb20xEzARBgNVBAoM +CmVybGFuZy5vcmcwHhcNMTYxMjIwMTUwNDUyWhcNMTcwMTE5MTUwNDUyWjByMQsw +CQYDVQQGEwJTRTEUMBIGA1UEAwwLZXhhbXBsZS5jb20xGjAYBgNVBAMMESouZm9v +LmV4YW1wbGUuY29tMRwwGgYDVQQDDBNhKmIuYmFyLmV4YW1wbGUuY29tMRMwEQYD +VQQKDAplcmxhbmcub3JnMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDVGJgZ +defGucvMXf0RrEm6Hb18IfVUo9IV6swSP/kwAu/608ZIZdzlfp2pxC0e72a4E3WN +4vrGxAr2wMMQOiyoy4qlAeLX27THJ6Q4Vl82fc6QuOJbScKIydSZ4KoB+luGlBu5 +b6xYh2pBbneKFpsecmK5rsWtTactjD4n1tKjUwIDAQABo1AwTjAdBgNVHQ4EFgQU +OCtzidUeaDva7qp12T0CQrgfLW4wHwYDVR0jBBgwFoAUOCtzidUeaDva7qp12T0C +QrgfLW4wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQsFAAOBgQCAz+ComCMo9Qbu +PHxG7pv3mQvoxrMFva/Asg4o9mW2mDyrk0DwI4zU8vMHbSRKSBYGm4TATXsQkDQT +gJw/bxhISnhZZtPC7Yup8kJCkJ6S6EDLYrlzgsRqfeU6jWim3nbfaLyMi9dHFDMk +HULnyNNW3qxTEKi8Wo2sCMej4l7KFg== +-----END CERTIFICATE----- diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem new file mode 100644 index 0000000000..83e1ad37b3 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICEjCCAXugAwIBAgIJANwliLph5EiAMA0GCSqGSIb3DQEBCwUAMCMxCzAJBgNV +BAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNvbTAeFw0xNjEyMjAxNTEyMjRaFw0x +NzAxMTkxNTEyMjRaMCMxCzAJBgNVBAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNv +bTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAydstIN157w8QxkVaOl3wm81j +fgZ8gqO3BXkECPF6bw5ewLlmePL6Qs4RypsaRe7cKJ9rHFlwhpdcYkxWSWEt2N7Z +Ry3N4SjuU04ohWbYgy3ijTt7bJg7jOV1Dh56BnI4hwhQj0oNFizNZOeRRfEzdMnS ++uk03t/Qre2NS7KbwnUCAwEAAaNOMEwwSgYDVR0RBEMwQYIOa2IuZXhhbXBsZS5v +cmeGFmh0dHA6Ly93d3cuZXhhbXBsZS5vcmeGF2h0dHBzOi8vd3dzLmV4YW1wbGUu +b3JnMA0GCSqGSIb3DQEBCwUAA4GBAKqFqW5gCso422bXriCBJoygokOTTOw1Rzpq +K8Mm0B8W9rrW9OTkoLEcjekllZcUCZFin2HovHC5HlHZz+mQvBI1M6sN2HVQbSzS +EgL66U9gwJVnn9/U1hXhJ0LO28aGbyE29DxnewNR741dWN3oFxCdlNaO6eMWaEsO +gduJ5sDl +-----END CERTIFICATE----- diff --git a/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf new file mode 100644 index 0000000000..a28864dc78 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf @@ -0,0 +1,16 @@ +[req] +prompt = no +distinguished_name = DN + +[DN] +C=SE +CN=example.com + +[SAN] +subjectAltName = @alt_names + +[alt_names] +DNS = kb.example.org +URI.1 = http://www.example.org +URI.2 = https://wws.example.org + diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index 82a4c79379..7aae5e5c41 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="utf8" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index e943fb4a3e..b27bc63d15 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -314,13 +314,12 @@ etop_collect(Collector) -> case SchedulerWallTime of undefined -> - spawn(fun() -> flag_holder_proc(Collector) end), + erlang:system_flag(scheduler_wall_time,true), + spawn(fun() -> flag_holder_proc(Collector) end), ok; _ -> ok - end, - - erlang:system_flag(scheduler_wall_time,true). + end. flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index fa503fa573..4ca4a08329 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -268,7 +268,7 @@ <fsummary>Creates a release package.</fsummary> <type> <v>Name = string()</v> - <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v> + <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir} | | no_warn_sasl | warnings_as_errors</v> <v> Dir = string()</v> <v> IncDir = src | include | atom()</v> <v> Var = {VarName,PreFix}</v> @@ -297,6 +297,10 @@ directory unless <c>Name</c> contains a path. If option <c>{outdir,Dir}</c> is specified, it is located in <c>Dir</c> instead.</p> + <p>If SASL is not included as an application in + the <c>.rel</c> file, a warning is issued because such a + release cannot be used in an upgrade. To turn off this + warning, add option <c>no_warn_sasl</c>.</p> <p>By default, the release package contains the directories <c>lib/App-Vsn/ebin</c> and <c>lib/App-Vsn/priv</c> for each included application. If more directories are to be included, diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index efe6cc9eb4..3a188e95ee 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -94,7 +94,11 @@ make_script(RelName, Output, Flags) when is_list(RelName), Warnings = wsasl(Flags, Warnings0), case systools_lib:werror(Flags, Warnings) of true -> - return(ok,Warnings,Flags); + Warnings1 = [W || {warning,W}<-Warnings], + return({error,?MODULE, + {warnings_treated_as_errors,Warnings1}}, + Warnings, + Flags); false -> case generate_script(Output,Release,Appls,Flags) of ok -> @@ -115,7 +119,6 @@ make_script(RelName, _Output, Flags) when is_list(Flags) -> make_script(RelName, _Output, Flags) -> badarg(Flags,[RelName, Flags]). - wsasl(Options, Warnings) -> case lists:member(no_warn_sasl,Options) of true -> lists:delete({warning,missing_sasl},Warnings); @@ -148,21 +151,10 @@ get_outdir(Flags) -> return(ok,Warnings,Flags) -> case member(silent,Flags) of true -> - case systools_lib:werror(Flags, Warnings) of - true -> - error; - false -> - {ok,?MODULE,Warnings} - end; + {ok,?MODULE,Warnings}; _ -> - case member(warnings_as_errors,Flags) of - true -> - io:format("~ts",[format_warning(Warnings, true)]), - error; - false -> - io:format("~ts",[format_warning(Warnings)]), - ok - end + io:format("~ts",[format_warning(Warnings)]), + ok end; return({error,Mod,Error},_,Flags) -> case member(silent,Flags) of @@ -300,6 +292,8 @@ add_apply_upgrade(Script,Args) -> %% {variables,[{Name,AbsString}]} %% {machine, jam | beam | vee} %% {var_tar, include | ownfile | omit} +%% no_warn_sasl +%% warnings_as_errors %% %% The tar file contains: %% lib/App-Vsn/ebin @@ -332,13 +326,23 @@ make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) -> Path = make_set(Path1 ++ code:get_path()), ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of - {ok, Release, Appls, Warnings} -> - case catch mk_tar(RelName, Release, Appls, Flags, Path1) of - ok -> - return(ok,Warnings,Flags); - Error -> - return(Error,Warnings,Flags) - end; + {ok, Release, Appls, Warnings0} -> + Warnings = wsasl(Flags, Warnings0), + case systools_lib:werror(Flags, Warnings) of + true -> + Warnings1 = [W || {warning,W}<-Warnings], + return({error,?MODULE, + {warnings_treated_as_errors,Warnings1}}, + Warnings, + Flags); + false -> + case catch mk_tar(RelName, Release, Appls, Flags, Path1) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end + end; Error -> return(Error,[],Flags) end; @@ -2109,90 +2113,80 @@ cas([Y | Args], X) -> %% Check Options for make_tar check_args_tar(Args) -> - cat(Args, {undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, []}). + cat(Args, []). -cat([], {_Path,_Sil,_Dirs,_Erts,_Test,_Var,_VarTar,_Mach,_Xref,_XrefApps, X}) -> +cat([], X) -> X; %%% path --------------------------------------------------------------- -cat([{path, P} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(P) -> +cat([{path, P} | Args], X) when is_list(P) -> case check_path(P) of ok -> - cat(Args, {P, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X++[{path,P}]}) + cat(Args, X++[{path,P}]) end; %%% silent ------------------------------------------------------------- -cat([silent | Args], {Path, _Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, silent, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([silent | Args], X) -> + cat(Args, X); %%% dirs --------------------------------------------------------------- -cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) -> +cat([{dirs, D} | Args], X) -> case check_dirs(D) of ok -> - cat(Args, {Path, Sil, D, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X++[{dirs, D}]}) + cat(Args, X++[{dirs, D}]) end; %%% erts --------------------------------------------------------------- -cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)-> - cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([{erts, E} | Args], X) when is_list(E)-> + cat(Args, X); %%% src_tests ---------------------------------------------------- -cat([src_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, src_tests, Var, VarTar, Mach, - Xref, XrefApps, X}); +cat([src_tests | Args], X) -> + cat(Args, X); %%% variables ---------------------------------------------------------- -cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) -> +cat([{variables, V} | Args], X) when is_list(V) -> case check_vars(V) of ok -> - cat(Args, {Path, Sil, Dirs, Erts, Test, V, VarTar, Mach, Xref, XrefApps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X++[{variables, V}]}) + cat(Args, X++[{variables, V}]) end; %%% var_tar ------------------------------------------------------------ -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == include -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, include, Mach, Xref, XrefApps, X}); -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == ownfile -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, ownfile, Mach, Xref, XrefApps, X}); -cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, - Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == omit -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, omit, Mach, Xref, XrefApps, X}); +cat([{var_tar, VT} | Args], X) when VT == include; + VT == ownfile; + VT == omit -> + cat(Args, X); %%% machine ------------------------------------------------------------ -cat([{machine, M} | Args], {Path, Sil, Dirs, Erts, Test, - Var, VarTar, Mach, Xref, XrefApps, X}) when is_atom(M) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([{machine, M} | Args], X) when is_atom(M) -> + cat(Args, X); %%% exref -------------------------------------------------------------- -cat([exref | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, _Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, exref, XrefApps, X}); +cat([exref | Args], X) -> + cat(Args, X); %%% exref Apps --------------------------------------------------------- -cat([{exref, Apps} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Apps) -> +cat([{exref, Apps} | Args], X) when is_list(Apps) -> case check_apps(Apps) of ok -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, Apps, X}); + cat(Args, X); error -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X++[{exref, Apps}]}) + cat(Args, X++[{exref, Apps}]) end; %%% outdir Dir --------------------------------------------------------- -cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Dir) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, - Xref, XrefApps, X}); +cat([{outdir, Dir} | Args], X) when is_list(Dir) -> + cat(Args, X); %%% otp_build (secret, not documented) --------------------------------- -cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([otp_build | Args], X) -> + cat(Args, X); +%%% warnings_as_errors ---- +cat([warnings_as_errors | Args], X) -> + cat(Args, X); +%%% no_warn_sasl ---- +cat([no_warn_sasl | Args], X) -> + cat(Args, X); %%% no_module_tests (kept for backwards compatibility, but ignored) ---- -cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +cat([no_module_tests | Args], X) -> + cat(Args, X); %%% ERROR -------------------------------------------------------------- -cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}). +cat([Y | Args], X) -> + cat(Args, X++[Y]). check_path([]) -> ok; @@ -2292,6 +2286,9 @@ format_error({delete,File,Error}) -> [File,file:format_error(Error)]); format_error({tar_error,What}) -> form_tar_err(What); +format_error({warnings_treated_as_errors,Warnings}) -> + io_lib:format("Warnings being treated as errors:~n~ts", + [map(fun(W) -> form_warn("",W) end, Warnings)]); format_error(ListOfErrors) when is_list(ListOfErrors) -> format_errors(ListOfErrors); format_error(E) -> io_lib:format("~p~n",[E]). @@ -2348,24 +2345,15 @@ form_tar_err({add, File, Error}) -> %% Format warning format_warning(Warnings) -> - format_warning(Warnings, false). - -format_warning(Warnings, Werror) -> - Prefix = case Werror of - true -> - ""; - false -> - "*WARNING* " - end, - map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). - -form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> + map(fun({warning,W}) -> form_warn("*WARNING* ", W) end, Warnings). + +form_warn(Prefix, {source_not_found,{Mod,App,_}}) -> io_lib:format("~ts~w: Source code not found: ~w.erl~n", [Prefix,App,Mod]); form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> io_lib:format("~ts~w: Parse error: ~p~n", [Prefix,App,File]); -form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> +form_warn(Prefix, {obj_out_of_date,{Mod,App,_}}) -> io_lib:format("~ts~w: Object code (~w) out of date~n", [Prefix,App,Mod]); form_warn(Prefix, {exref_undef, Undef}) -> @@ -2375,8 +2363,8 @@ form_warn(Prefix, {exref_undef, Undef}) -> end, map(F, Undef); form_warn(Prefix, missing_sasl) -> - io_lib:format("~ts: Missing application sasl. " + io_lib:format("~tsMissing application sasl. " "Can not upgrade with this release~n", [Prefix]); form_warn(Prefix, What) -> - io_lib:format("~ts ~p~n", [Prefix,What]). + io_lib:format("~ts~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 28534dc0c8..7e1844b400 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -155,36 +155,12 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) -> mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> case check_opts(Opts) of [] -> - R = (catch do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs, - add_code_path(Opts), Opts)), - case {get_opt(silent, Opts), get_opt(noexec, Opts)} of - {false, false} -> - case R of - {ok, _Res, _Mod, Ws} -> - print_warnings(Ws, Opts), - case systools_lib:werror(Opts, Ws) of - true -> - error; - false -> - ok - end; - Other -> - print_error(Other), - error - end; - _ -> - case R of - {ok, _Res, _Mod, Ws} -> - case systools_lib:werror(Opts, Ws) of - true -> - error; - false -> - R - end; - R -> - R - end - end; + R = try do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs, + add_code_path(Opts), Opts) + catch throw:Error -> + Error + end, + done_mk_relup(Opts, R); BadArg -> erlang:error({badarg, BadArg}) end. @@ -224,17 +200,45 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> {Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs, Path, Opts, Ws1), Relup = {TopRel#release.vsn, Up, Dn}, - case systools_lib:werror(Opts, Ws2) of - true -> - ok; - false -> - write_relup_file(Relup, Opts) - end, - {ok, Relup, ?MODULE, Ws2}; + + {ok, Relup, Ws2}; Other -> - throw(Other) + Other end. +done_mk_relup(Opts, {ok,Relup,Ws}) -> + WAE = get_opt(warnings_as_errors,Opts), + Silent = get_opt(silent,Opts), + Noexec = get_opt(noexec,Opts), + + if WAE andalso Ws=/=[] -> + return_error(Silent, + {error,?MODULE,{warnings_treated_as_errors, Ws}}); + not Noexec -> + case write_relup_file(Relup,Opts) of + ok -> + return_ok(Silent,Relup,Ws); + Error -> + return_error(Silent,Error) + end; + true -> % noexec + return_ok(true,Relup,Ws) + end; +done_mk_relup(Opts, Error) -> + return_error(get_opt(silent,Opts) orelse get_opt(noexec,Opts), Error). + +return_error(true, Error) -> + Error; +return_error(false, Error) -> + print_error(Error), + error. + +return_ok(true,Relup,Ws) -> + {ok,Relup,?MODULE,Ws}; +return_ok(false,_Relup,Ws) -> + print_warnings(Ws), + ok. + %%----------------------------------------------------------------- %% foreach_baserel_up(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret %% foreach_baserel_dn(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret @@ -529,33 +533,18 @@ to_list(X) when is_list(X) -> X. %% Writes a relup file. %% write_relup_file(Relup, Opts) -> - case get_opt(noexec, Opts) of - true -> - ok; - _ -> - Filename = case get_opt(outdir, Opts) of - OutDir when is_list(OutDir) -> - filename:join(filename:absname(OutDir), - "relup"); - false -> - "relup"; - Badarg -> - throw({error, ?MODULE, {badarg, {outdir,Badarg}}}) - end, - - case file:open(Filename, [write]) of - {ok, Fd} -> - io:format(Fd, "~p.~n", [Relup]), - case file:close(Fd) of - ok -> ok; - {error,Reason} -> - throw({error, ?MODULE, - {file_problem, {"relup", {close,Reason}}}}) - end; - {error, Reason} -> - throw({error, ?MODULE, - {file_problem, {"relup", {open, Reason}}}}) - end + Filename = filename:join(filename:absname(get_opt(outdir,Opts)), + "relup"), + case file:open(Filename, [write]) of + {ok, Fd} -> + io:format(Fd, "~p.~n", [Relup]), + case file:close(Fd) of + ok -> ok; + {error,Reason} -> + {error, ?MODULE, {file_problem, {"relup", {close,Reason}}}} + end; + {error, Reason} -> + {error, ?MODULE, {file_problem, {"relup", {open, Reason}}}} end. add_code_path(Opts) -> @@ -593,10 +582,9 @@ default(path) -> false; default(noexec) -> false; default(silent) -> false; default(restart_emulator) -> false; -default(outdir) -> false. +default(outdir) -> "."; +default(warnings_as_errors) -> false. -print_error({'EXIT', Err}) -> - print_error(Err); print_error({error, Mod, Error}) -> S = apply(Mod, format_error, [Error]), io:format(S, []); @@ -614,24 +602,20 @@ format_error({missing_sasl,Release}) -> io_lib:format("No sasl application in release ~ts, ~ts. " "Can not be upgraded.", [Release#release.name, Release#release.vsn]); +format_error({warnings_treated_as_errors, Warnings}) -> + io_lib:format("Warnings being treated as errors:~n~ts", + [[format_warning("",W) || W <- Warnings]]); format_error(Error) -> - io:format("~p~n", [Error]). + io_lib:format("~p~n", [Error]). -print_warnings(Ws, Opts) when is_list(Ws) -> - lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws); -print_warnings(W, Opts) -> - print_warning(W, Opts). +print_warnings(Ws) when is_list(Ws) -> + lists:foreach(fun(W) -> print_warning(W) end, Ws); +print_warnings(W) -> + print_warning(W). -print_warning(W, Opts) -> - Prefix = case lists:member(warnings_as_errors, Opts) of - true -> - ""; - false -> - "*WARNING* " - end, - S = format_warning(Prefix, W), - io:format("~ts", [S]). +print_warning(W) -> + io:format("~ts", [format_warning(W)]). format_warning(W) -> format_warning("*WARNING* ", W). @@ -639,6 +623,8 @@ format_warning(W) -> format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> io_lib:format("~tsThe ERTS version changed between ~p and ~p~n", [Prefix, Rel1, Rel2]); +format_warning(Prefix, pre_R15_emulator_upgrade) -> + io_lib:format("~tsUpgrade from an OTP version earlier than R15. New code should be compiled with the old emulator.~n",[Prefix]); format_warning(Prefix, What) -> io_lib:format("~ts~p~n",[Prefix, What]). diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start index 87275045b1..eab2b77aed 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start +++ b/lib/sasl/test/release_handler_SUITE_data/start @@ -21,8 +21,7 @@ then fi HEART_COMMAND=$ROOTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client index 5ea94d6f7c..05d744f06e 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start_client +++ b/lib/sasl/test/release_handler_SUITE_data/start_client @@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases # Note that this scripts is modified an copied to $CLIENTDIR/bin/start # in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows: HEART_COMMAND=$CLIENTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index bf95ceb70c..cce73f5bce 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -29,6 +29,8 @@ -module(systools_SUITE). +-compile(export_all). + %%-define(debug, true). -include_lib("common_test/include/ct.hrl"). @@ -39,31 +41,6 @@ -include_lib("kernel/include/file.hrl"). --export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]). - --export([script_options/1, normal_script/1, unicode_script/1, - unicode_script/2, no_mod_vsn_script/1, - wildcard_script/1, variable_script/1, no_sasl_script/1, - no_dot_erlang_script/1, - abnormal_script/1, src_tests_script/1, crazy_script/1, - included_script/1, included_override_script/1, - included_fail_script/1, included_bug_script/1, exref_script/1, - duplicate_modules_script/1, - otp_3065_circular_dependenies/1, included_and_used_sort_script/1]). --export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, system_files_tar/1, - system_files_tar/2, invalid_system_files_tar/1, - invalid_system_files_tar/2, variable_tar/1, - src_tests_tar/1, var_tar/1, exref_tar/1, link_tar/1, - otp_9507_path_ebin/1]). --export([normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1, - no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, - regexp_relup/1]). --export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]). --export([otp_6226_outdir/1]). --export([init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). --export([delete_tree/1]). - -import(lists, [foldl/3]). -define(default_timeout, ?t:minutes(20)). @@ -91,7 +68,8 @@ groups() -> {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, system_files_tar, invalid_system_files_tar, variable_tar, - src_tests_tar, var_tar, exref_tar, link_tar, otp_9507_path_ebin]}, + src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar, + otp_9507_path_ebin]}, {relup, [], [normal_relup, restart_relup, abnormal_relup, no_sasl_relup, no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup @@ -238,6 +216,7 @@ normal_script(Config) when is_list(Config) -> %% Check the same but w. silent flag {ok, _, []} = systools:make_script(LatestName, [silent]), + {ok, _, []} = systools:make_script(LatestName, [silent,warnings_as_errors]), %% Use the local option ok = systools:make_script(LatestName, [local]), @@ -456,9 +435,16 @@ no_sasl_script(Config) when is_list(Config) -> {ok, _ , [{warning,missing_sasl}]} = systools:make_script(LatestName,[{path, P},silent]), + {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} = + systools:make_script(LatestName,[{path, P},silent,warnings_as_errors]), + {ok, _ , []} = systools:make_script(LatestName,[{path, P},silent, no_warn_sasl]), + {ok, _ , []} = + systools:make_script(LatestName,[{path, P},silent, no_warn_sasl, + warnings_as_errors]), + ok = file:set_cwd(OldDir), ok. @@ -525,7 +511,9 @@ src_tests_script(Config) when is_list(Config) -> ok = file:delete(BootFile), false = filelib:is_regular(BootFile), %% With warnings_as_errors and src_tests option, an error should be issued - error = + {error, systools_make, + {warnings_treated_as_errors, [{obj_out_of_date,_}, + {source_not_found,_}]}} = systools:make_script(LatestName, [silent, {path, N}, src_tests, warnings_as_errors]), error = @@ -745,7 +733,7 @@ exref_script(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]), + {ok, _, []} = systools:make_script(LatestName, [{path,P}, silent]), %% Complete exref {ok, _, W1} = @@ -894,10 +882,10 @@ normal_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), ok = file:set_cwd(OldDir), @@ -918,10 +906,10 @@ no_mod_vsn_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), ok = file:set_cwd(OldDir), @@ -945,11 +933,11 @@ system_files_tar(Config) -> ok = file:write_file("sys.config","[].\n"), ok = file:write_file("relup","{\"LATEST\",[],[]}.\n"), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), ok = systools:make_tar(LatestName, [{path, P}]), ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), ok = check_tar(fname(["releases","LATEST","relup"]), LatestName), - {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), ok = check_tar(fname(["releases","LATEST","relup"]), LatestName), @@ -978,7 +966,7 @@ invalid_system_files_tar(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), %% Add dummy relup and sys.config - faulty sys.config ok = file:write_file("sys.config","[]\n"), %!!! syntax error - missing '.' @@ -1036,7 +1024,7 @@ variable_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}, {variables,[{"TEST", LibDir}]}]), @@ -1045,7 +1033,7 @@ variable_tar(Config) when is_list(Config) -> {variables,[{"TEST", LibDir}]}]), ok = check_var_tar("TEST", LatestName), - {ok, _, _} = systools:make_tar(LatestName, + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, {variables,[{"TEST", LibDir}]}]), ok = check_var_tar("TEST", LatestName), @@ -1174,7 +1162,7 @@ var_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}, {variables,[{"TEST", LibDir}]}]), @@ -1218,7 +1206,7 @@ exref_tar(Config) when is_list(Config) -> ok = file:set_cwd(LatestDir), - {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]), %% Complete exref {ok, _, W1} = @@ -1248,7 +1236,41 @@ exref_tar(Config) when is_list(Config) -> ok = file:set_cwd(OldDir), ok. +%% make_tar: Create tar without sasl appl. Check warning. +no_sasl_tar(Config) when is_list(Config) -> + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_script(latest1_no_sasl,Config), + + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + + ok = file:set_cwd(LatestDir), + + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + ok = systools:make_tar(LatestName, [{path, P}]), + {ok, _, [{warning,missing_sasl}]} = + systools:make_tar(LatestName, [{path, P}, silent]), + {ok, _, []} = + systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl]), + {ok, _, []} = + systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl, + warnings_as_errors]), + TarFile = LatestName ++ ".tar.gz", + true = filelib:is_regular(TarFile), + ok = file:delete(TarFile), + {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} = + systools:make_tar(LatestName, [{path, P}, silent, warnings_as_errors]), + error = + systools:make_tar(LatestName, [{path, P}, warnings_as_errors]), + false = filelib:is_regular(TarFile), + + ok = file:set_cwd(OldDir), + ok. %% make_tar: OTP-9507 - make_tar failed when path given as just 'ebin'. otp_9507_path_ebin(Config) when is_list(Config) -> @@ -1268,7 +1290,7 @@ otp_9507_path_ebin(Config) when is_list(Config) -> fname([DataDir, lib, kernel, ebin]), fname([DataDir, lib, stdlib, ebin]), fname([DataDir, lib, sasl, ebin])], - {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), + {ok, _, []} = systools:make_script(RelName, [silent, {path, P1}]), ok = systools:make_tar(RelName, [{path, P1}]), Content1 = tar_contents(RelName), @@ -1309,7 +1331,7 @@ normal_relup(Config) when is_list(Config) -> ok = systools:make_relup(LatestName, [LatestName1], [LatestName1], [{path, P}]), ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), - {ok, _, _, []} = + {ok, Relup, _, []} = systools:make_relup(LatestName, [LatestName1], [LatestName1], [{path, P}, silent]), ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), @@ -1322,7 +1344,9 @@ normal_relup(Config) when is_list(Config) -> error = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, warnings_as_errors]), - error = + {error, systools_relup, + {warnings_treated_as_errors,[pre_R15_emulator_upgrade, + {erts_vsn_changed, _}]}} = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, silent, warnings_as_errors]), @@ -1341,6 +1365,14 @@ normal_relup(Config) when is_list(Config) -> %% relup file should exist now true = filelib:is_regular("relup"), + %% file should not be written if noexec option is used. + %% delete before running tests. + ok = file:delete("relup"), + {ok,Relup,_,[]} = + systools:make_relup(LatestName, [LatestName1], [LatestName1], + [{path, P}, noexec]), + false = filelib:is_regular("relup"), + ok = file:set_cwd(OldDir), ok. diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index ca61782639..db09ec3dc5 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -8,6 +8,10 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ], @@ -17,6 +21,10 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ] diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index df3933ea01..8a736f688b 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. @@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) -> CompDate = case key1search(compile_time, Info) of {value, {Year, Month, Day, Hour, Min, Sec}} -> - lists:flatten( - io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec])); + io_lib:format( + "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]); + _ -> + "Not found" + end, + Digest = + case key1search(md5, Info) of + {value, MD5} when is_binary(MD5) -> + [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5]; _ -> "Not found" end, @@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) -> "~s Vsn: ~s~n" "~s App vsn: ~s~n" "~s Compiler ver: ~s~n" - "~s Compile time: ~s~n", + "~s Compile time: ~s~n" + "~s MD5 digest: ~s~n", [Prefix, Module, Prefix, Vsn, Prefix, AppVsn, - Prefix, CompVer, - Prefix, CompDate]), + Prefix, CompVer, + Prefix, CompDate, + Prefix, Digest]), ok. key1search(Key, Vals) -> @@ -617,7 +626,7 @@ versions1() -> Error -> Error end. - + versions2() -> case ms2() of {ok, Mods} -> @@ -625,25 +634,56 @@ versions2() -> Error -> Error end. - + version_info(Mods) -> SysInfo = sys_info(), OsInfo = os_info(), ModInfo = [mod_version_info(Mod) || Mod <- Mods], [{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}]. - + mod_version_info(Mod) -> Info = Mod:module_info(), - {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info), - {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr), - {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr), - {value, {compile, Comp}} = lists:keysearch(compile, 1, Info), - {value, {version, Ver}} = lists:keysearch(version, 1, Comp), - {value, {time, Time}} = lists:keysearch(time, 1, Comp), - {Mod, [{vsn, Vsn}, - {app_vsn, AppVsn}, - {compiler_version, Ver}, - {compile_time, Time}]}. + {Mod, + case key1search(attributes, Info) of + {value, Attr} -> + case key1search(vsn, Attr) of + {value, [Vsn]} -> + [{vsn, Vsn}]; + not_found -> + [] + end ++ + case key1search(app_vsn, Attr) of + {value, AppVsn} -> + [{app_vsn, AppVsn}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(compile, Info) of + {value, Comp} -> + case key1search(version, Comp) of + {value, Ver} -> + [{compiler_version, Ver}]; + not_found -> + [] + end ++ + case key1search(time, Comp) of + {value, Ver} -> + [{compile_time, Ver}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(md5, Info) of + {value, Bin} -> + [{md5, Bin}]; + not_found -> + [] + end}. sys_info() -> SysArch = string:strip(erlang:system_info(system_architecture),right,$\n), diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index 51690b6e7e..33ddd78308 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. @@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) -> print_error("Undefined type '~w'",[Type],Line), guess_string_type() end; -make_ASN1type({{integer_with_enum,Type,Enums},Line}) -> +make_ASN1type({{type_with_enum,Type,Enums},Line}) -> case lookup_vartype(Type) of {value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]}; false -> diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl index 743c3a6550..14a668127e 100644 --- a/lib/snmp/src/compile/snmpc_mib_gram.yrl +++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. @@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}. syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}. syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}. syntax -> 'INTEGER' '{' namedbits '}' : - {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}. + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'BITS' '{' namedbits '}' : ensure_ver(2,'$1'), {{bits, '$3'}, line_of('$1')}. +syntax -> usertype '{' namedbits '}' : + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'SEQUENCE' 'OF' usertype : {{sequence_of,val('$3')},line_of('$1')}. diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2c8851c2a7..9b3c2bfd2c 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-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. @@ -56,7 +56,8 @@ otp_8574/1, otp_8595/1, otp_10799/1, - otp_10808/1 + otp_10808/1, + otp_14145/1 ]). @@ -135,7 +136,8 @@ all() -> ]. groups() -> - [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}]. + [{tickets, [], + [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}]. init_per_group(_GroupName, Config) -> Config. @@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) -> %%====================================================================== +otp_14145(suite) -> + []; +otp_14145(Config) when is_list(Config) -> + put(tname, otp10808), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibName = "OTP14145-MIB", + MibFile = join(MibDir, MibName++".mib"), + ?line {ok, MibBin} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}, + module_compliance]), + p("Mib: ~n~p~n", [MibBin]), + MIB = read_mib(MibBin), + Oid = [1,3,6,1,2,1,67,4], + check_mib(MIB#mib.mes, Oid, undefined), + ok. + + +%%====================================================================== + augments_extra_info(suite) -> []; augments_extra_info(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib new file mode 100644 index 0000000000..f29c65c4c2 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib @@ -0,0 +1,44 @@ +OTP14145-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, + mib-2 FROM SNMPv2-SMI + InetAddressType, InetAddress FROM INET-ADDRESS-MIB + MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF; + +testMibId MODULE-IDENTITY + LAST-UPDATED "200608210000Z" -- 21 August 2006 + ORGANIZATION "a" + CONTACT-INFO "a" + DESCRIPTION "a" + REVISION "200608210000Z" -- 21 August 2006 + DESCRIPTION "a" + ::= { mib-2 67 } + +testObj OBJECT-TYPE + SYNTAX InetAddressType + -- SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION "a" + ::= { testMibId 2 } + +testObjId OBJECT IDENTIFIER ::= { testMibId 3 } + +testMibCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION "a" + MODULE + OBJECT testObj + SYNTAX InetAddressType { ipv4(1), ipv6(2) } + -- SYNTAX InetAddress ( SIZE(4|16) ) + DESCRIPTION "a" + ::= { testMibId 4 } + +testObjGroup OBJECT-GROUP + OBJECTS { testObj } + STATUS current + DESCRIPTION "a" + ::= { testObjId 1 } + +END diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 28eba0d0d6..30b8ee1124 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-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. @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.4 +SNMP_VSN = 5.2.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 6b49f89449..f6e26f5ee8 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -153,7 +153,7 @@ <item> <p>IP version to use.</p> </item> - <tag><c><![CDATA[{user_dir, string()}]]></c></tag> + <tag><marker id="opt_user_dir"></marker><c><![CDATA[{user_dir, string()}]]></c></tag> <item> <p>Sets the user directory, that is, the directory containing <c>ssh</c> configuration files for the user, such as @@ -175,22 +175,48 @@ supplied with this option. </p> </item> - <tag><c><![CDATA[{silently_accept_hosts, boolean() | accept_fun() | {crypto:digest_type(), accept_fun()} }]]></c> - <br/> - <c><![CDATA[accept_fun() :: fun(PeerName::string(), FingerPrint::string()) -> boolean()]]></c> + <tag> + <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/> + <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/> + <c><![CDATA[{silently_accept_hosts, {HashAlgoSpec, CallbackFun} }]]></c> <br/> + <br/> + <c><![CDATA[HashAlgoSpec = crypto:digest_type() | [ crypto:digest_type() ] ]]></c><br/> + <c><![CDATA[CallbackFun = fun(PeerName, FingerPrint) -> boolean()]]></c><br/> + <c><![CDATA[PeerName = string()]]></c><br/> + <c><![CDATA[FingerPrint = string() | [ string() ] ]]></c> </tag> <item> - <p>When <c>true</c>, hosts are added to the - file <c><![CDATA[known_hosts]]></c> without asking the user. - Defaults to <c>false</c> which will give a user question on stdio of whether to accept or reject a previously - unseen host.</p> - <p>If the option value is has an <c>accept_fun()</c>, that fun will called with the arguments - <c>(PeerName, PeerHostKeyFingerPrint)</c>. The fingerprint is calculated on the Peer's Host Key with - <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso>. - </p> - <p>If the <c>crypto:digest_type()</c> is present, the fingerprint is calculated with that digest type by the function - <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>. - </p> + <p>This option guides the <c>connect</c> function how to act when the connected server presents a Host + Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to + accept or reject the new Host Key. + See also the option <seealso marker="#opt_user_dir"><c>user_dir</c></seealso> + for the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded. + </p> + <p>The option can be given in three different forms as seen above:</p> + <list> + <item>The value is a <c>boolean()</c>. The value <c>true</c> will make the client accept any unknown + Host Key without any user interaction. The value <c>false</c> keeps the default behaviour of asking the + the user on stdio. + </item> + <item>A <c>CallbackFun</c> will be called and the boolean return value <c>true</c> will make the client + accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and therefore + also the connection will be closed. The arguments to the fun are: + <list type="bulleted"> + <item><c>PeerName</c> - a string with the name or address of the remote host.</item> + <item><c>FingerPrint</c> - the fingerprint of the Host Key as + <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso> + calculates it. + </item> + </list> + </item> + <item>A tuple <c>{HashAlgoSpec, CallbackFun}</c>. The <c>HashAlgoSpec</c> specifies which hash algorithm + shall be used to calculate the fingerprint used in the call of the <c>CallbackFun</c>. The <c>HashALgoSpec</c> + is either an atom or a list of atoms as the first argument in + <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>. + If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the <c>CallbackFun</c> will be + a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list. + </item> + </list> </item> <tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag> <item> @@ -200,7 +226,7 @@ supplying a password. Defaults to <c>true</c>. Even if user interaction is allowed it can be suppressed by other options, such as <c>silently_accept_hosts</c> - and <c>password</c>. However, those optins are not always desirable + and <c>password</c>. However, those options are not always desirable to use from a security point of view.</p> </item> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 0861c641c7..864378b640 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -305,7 +305,7 @@ ok = erl_tar:close(HandleRead), <code type="erl" > -module(ssh_echo_server). --behaviour(ssh_subsystem). +-behaviour(ssh_daemon_channel). -record(state, { n, id, diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 76b7d8cd55..2bb7491b0c 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -48,4 +48,3 @@ "stdlib-3.1" ]}]}. - diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 31e343e81b..68d98d3875 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -280,9 +280,11 @@ valid_socket_to_use(Socket, Options) -> {error, {unsupported,L4}} end. -is_tcp_socket(Socket) -> {ok,[]} =/= inet:getopts(Socket, [delay_send]). - - +is_tcp_socket(Socket) -> + case inet:getopts(Socket, [delay_send]) of + {ok,[_]} -> true; + _ -> false + end. daemon_shell_opt(Options) -> case proplists:get_value(shell, Options) of @@ -317,6 +319,7 @@ start_daemon(Socket, Options) -> do_start_daemon(Socket, [{role,server}|SshOptions], SocketOptions) catch throw:bad_fd -> {error,bad_fd}; + throw:bad_socket -> {error,bad_socket}; _C:_E -> {error,{cannot_start_daemon,_C,_E}} end; {error,SockError} -> @@ -333,6 +336,7 @@ start_daemon(Host, Port, Options, Inet) -> do_start_daemon(Host, Port, [{role,server}|SshOptions] , [Inet|SocketOptions]) catch throw:bad_fd -> {error,bad_fd}; + throw:bad_socket -> {error,bad_socket}; _C:_E -> {error,{cannot_start_daemon,_C,_E}} end end. @@ -362,8 +366,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) -> {error, {already_started, _}} -> {error, eaddrinuse}; Result = {ok,_} -> - ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket), - Result; + call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, Result); Result = {error, _} -> Result catch @@ -376,8 +379,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) -> {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> - ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket), - {ok, Sup}; + call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, {ok, Sup}); Other -> Other end @@ -447,6 +449,16 @@ do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> end end. +call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, DefaultResult) -> + try ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket) + of + {error,Error} -> {error,Error}; + _ -> DefaultResult + catch + C:R -> {error,{could_not_start_connection,{C,R}}} + end. + + sync_request_control(false) -> ok; sync_request_control({LSock,Callback}) -> @@ -620,11 +632,22 @@ handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) - handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_function(Value,2) -> Opt; handle_ssh_option({silently_accept_hosts, {DigestAlg,Value}} = Opt) when is_function(Value,2) -> - case lists:member(DigestAlg, [md5, sha, sha224, sha256, sha384, sha512]) of - true -> - Opt; - false -> - throw({error, {eoptions, Opt}}) + Algs = if is_atom(DigestAlg) -> [DigestAlg]; + is_list(DigestAlg) -> DigestAlg; + true -> throw({error, {eoptions, Opt}}) + end, + case [A || A <- Algs, + not lists:member(A, [md5, sha, sha224, sha256, sha384, sha512])] of + [_|_] = UnSup1 -> + throw({error, {{eoptions, Opt}, {not_fingerprint_algos,UnSup1}}}); + [] -> + CryptoHashAlgs = proplists:get_value(hashs, crypto:supports(), []), + case [A || A <- Algs, + not lists:member(A, CryptoHashAlgs)] of + [_|_] = UnSup2 -> + throw({error, {{eoptions, Opt}, {unsupported_algo,UnSup2}}}); + [] -> Opt + end end; handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) -> Opt; diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index ac35b70209..9b54ecb2dd 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -406,7 +406,11 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, kb_tries_left = KbTriesLeft, user = User, userauth_supported_methods = Methods} = Ssh) -> - SendOneEmpty = proplists:get_value(tstflg, Opts) == one_empty, + SendOneEmpty = + (proplists:get_value(tstflg,Opts) == one_empty) + orelse + proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false), + case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of {true,Ssh1} when SendOneEmpty==true -> Msg = #ssh_msg_userauth_info_request{name = "", diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 8af0ecc5f9..6f8c050486 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -453,14 +453,20 @@ move_cursor(From, To, #ssh_pty{width=Width, term=Type}) -> %% %%% make sure that there is data to send %% %%% before calling ssh_connection:send write_chars(ConnectionHandler, ChannelId, Chars) -> - case erlang:iolist_size(Chars) of - 0 -> - ok; - _ -> - ssh_connection:send(ConnectionHandler, ChannelId, - ?SSH_EXTENDED_DATA_DEFAULT, Chars) + case has_chars(Chars) of + false -> ok; + true -> ssh_connection:send(ConnectionHandler, + ChannelId, + ?SSH_EXTENDED_DATA_DEFAULT, + Chars) end. +has_chars([C|_]) when is_integer(C) -> true; +has_chars([H|T]) when is_list(H) ; is_binary(H) -> has_chars(H) orelse has_chars(T); +has_chars(<<_:8,_/binary>>) -> true; +has_chars(_) -> false. + + %%% tail, works with empty lists tl1([_|A]) -> A; tl1(_) -> []. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 7451c9e6d0..4496c657c3 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -609,13 +609,15 @@ handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> %%%---- diffie-hellman group exchange handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> @@ -1206,7 +1208,7 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, catch _C:_E -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input"}, + description = "Bad packet"}, StateName, D) end; @@ -1221,13 +1223,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, {bad_mac, Ssh1} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac"}, + description = "Bad packet"}, StateName, D0#data{ssh_params=Ssh1}); - {error, {exceeds_max_size,PacketLen}} -> + {error, {exceeds_max_size,_PacketLen}} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen)}, + description = "Bad packet"}, StateName, D0) catch _C:_E -> diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index dff2bae9f2..0345bbdea7 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -50,50 +50,61 @@ messages(Write, MangleArg) when is_function(Write,2), is_function(MangleArg,1) -> catch dbg:start(), setup_tracer(Write, MangleArg), - dbg:p(new,c), + dbg:p(new,[c,timestamp]), dbg_ssh_messages(). dbg_ssh_messages() -> dbg:tp(ssh_message,encode,1, x), dbg:tp(ssh_message,decode,1, x), - dbg:tpl(ssh_transport,select_algorithm,3, x). - + dbg:tpl(ssh_transport,select_algorithm,3, x), + dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x). + %%%---------------------------------------------------------------- stop() -> dbg:stop(). %%%================================================================ -msg_formater({trace,Pid,call,{ssh_message,encode,[Msg]}}, D) -> - fmt("~nSEND ~p ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace,_Pid,return_from,{ssh_message,encode,1},_Res}, D) -> +msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) -> + fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) -> D; -msg_formater({trace,_Pid,call,{ssh_message,decode,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_message,decode,1},Msg}, D) -> - fmt("~n~p RECV ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) -> + fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace,_Pid,call,{ssh_transport,select_algorithm,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) -> + D; +msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg},TS}, D) -> + fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D); + +msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg}}, D) -> - fmt("~n~p ALGORITHMS~n~s~n", [Pid, wr_record(Alg)], D); +msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) -> + fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) -> + fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) -> + D; -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Pid}, D) -> - fmt("~n~p TCP SEND on ~p~n ~p~n", [Pid,Sock, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) -> + fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Dest}, D) -> - fmt("~n~p TCP SEND from ~p TO ~p~n ~p~n", [Pid,Sock,Dest, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) -> + fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,ErlangMsg,Dest}, D) -> - fmt("~n~p ERL MSG SEND TO ~p~n ~p~n", [Pid,Dest, shrink_bin(ErlangMsg)], D); +msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) -> + fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D); -msg_formater({trace,Pid,'receive',{tcp,Sock,Bytes}}, D) -> - fmt("~n~p TCP RECEIVE on ~p~n ~p~n", [Pid,Sock,shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) -> + fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D); -msg_formater({trace,Pid,'receive',ErlangMsg}, D) -> - fmt("~n~p ERL MSG RECEIVE~n ~p~n", [Pid,shrink_bin(ErlangMsg)], D); +msg_formater({trace_ts,Pid,'receive',ErlangMsg,TS}, D) -> + fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D); msg_formater(M, D) -> @@ -106,6 +117,11 @@ msg_formater(M, D) -> fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) -> D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}. +ts({_,_,Usec}=Now) -> + {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now), + io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]); +ts(_) -> + "-". %%%---------------------------------------------------------------- setup_tracer(Write, MangleArg) -> Handler = fun(Arg, D) -> @@ -116,11 +132,11 @@ setup_tracer(Write, MangleArg) -> ok. %%%---------------------------------------------------------------- -shrink_bin(B) when is_binary(B), size(B)>100 -> {'*** SHRINKED BIN', +shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN', size(B), - element(1,split_binary(B,20)), + element(1,split_binary(B,64)), '...', - element(2,split_binary(B,size(B)-20)) + element(2,split_binary(B,size(B)-64)) }; shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L); shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T))); diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index b739955836..9352046795 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -664,29 +664,25 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> - #state{file_handler = FileMod, file_state = FS0, root = Root, xf = #ssh_xfer{vsn = Vsn}} = State0, - XF = State0#state.xf, - F = [binary | Flags], - {IsDir, _FS1} = FileMod:is_dir(Path, FS0), + #state{file_handler = FileMod, file_state = FS0, xf = #ssh_xfer{vsn = Vsn}} = State0, + AbsPath = relate_file_name(Path, State0), + {IsDir, _FS1} = FileMod:is_dir(AbsPath, FS0), case IsDir of true when Vsn > 5 -> ssh_xfer:xf_send_status(State0#state.xf, ReqId, - ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory"); + ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory"), + State0; true -> ssh_xfer:xf_send_status(State0#state.xf, ReqId, - ?SSH_FX_FAILURE, "File is a directory"); + ?SSH_FX_FAILURE, "File is a directory"), + State0; false -> - AbsPath = case Root of - "" -> - Path; - _ -> - relate_file_name(Path, State0) - end, - {Res, FS1} = FileMod:open(AbsPath, F, FS0), + OpenFlags = [binary | Flags], + {Res, FS1} = FileMod:open(AbsPath, OpenFlags, FS0), State1 = State0#state{file_state = FS1}, case Res of {ok, IoDevice} -> - add_handle(State1, XF, ReqId, file, {Path,IoDevice}); + add_handle(State1, State0#state.xf, ReqId, file, {Path,IoDevice}); {error, Error} -> ssh_xfer:xf_send_status(State1#state.xf, ReqId, ssh_xfer:encode_erlang_status(Error)), @@ -742,6 +738,10 @@ resolve_symlinks_2([], State, _LinkCnt, AccPath) -> {{ok, AccPath}, State}. +%% The File argument is always in a user visible file system, i.e. +%% is under Root and is relative to CWD or Root, if starts with "/". +%% The result of the function is always an absolute path in a +%% "backend" file system. relate_file_name(File, State) -> relate_file_name(File, State, _Canonicalize=true). @@ -749,19 +749,20 @@ relate_file_name(File, State, Canonicalize) when is_binary(File) -> relate_file_name(unicode:characters_to_list(File), State, Canonicalize); relate_file_name(File, #state{cwd = CWD, root = ""}, Canonicalize) -> relate_filename_to_path(File, CWD, Canonicalize); -relate_file_name(File, #state{root = Root}, Canonicalize) -> - case is_within_root(Root, File) of - true -> - File; - false -> - RelFile = make_relative_filename(File), - NewFile = relate_filename_to_path(RelFile, Root, Canonicalize), - case is_within_root(Root, NewFile) of - true -> - NewFile; - false -> - Root - end +relate_file_name(File, #state{cwd = CWD, root = Root}, Canonicalize) -> + CWD1 = case is_within_root(Root, CWD) of + true -> CWD; + false -> Root + end, + AbsFile = case make_relative_filename(File) of + File -> + relate_filename_to_path(File, CWD1, Canonicalize); + RelFile -> + relate_filename_to_path(RelFile, Root, Canonicalize) + end, + case is_within_root(Root, AbsFile) of + true -> AbsFile; + false -> Root end. is_within_root(Root, File) -> diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl index 78f452df67..e444e52ac0 100644 --- a/lib/ssh/src/ssh_sftpd_file_api.erl +++ b/lib/ssh/src/ssh_sftpd_file_api.erl @@ -36,7 +36,7 @@ -callback list_dir(file:name(), State::term()) -> {{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_dir(Dir::term(), State::term()) -> - {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}. + {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_symlink(Path2::term(), Path::term(), State::term()) -> {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback open(Path::term(), Flags::term(), State::term()) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 21ba34506a..a7cc4cd52c 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -44,6 +44,7 @@ handle_kexdh_reply/2, handle_kex_ecdh_init/2, handle_kex_ecdh_reply/2, + parallell_gen_key/1, extract_public_key/1, ssh_packet/2, pack/2, sha/1, sign/3, verify/4]). @@ -296,9 +297,6 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, end. -%% TODO: diffie-hellman-group14-sha1 should also be supported. -%% Maybe check more things ... - verify_algorithm(#alg{kex = undefined}) -> false; verify_algorithm(#alg{hkey = undefined}) -> false; verify_algorithm(#alg{send_mac = undefined}) -> false; @@ -316,17 +314,29 @@ verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex) key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ; Kex == 'diffie-hellman-group14-sha1' -> {G, P} = dh_group(Kex), - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}; key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ; Kex == 'diffie-hellman-group-exchange-sha256' -> - {Min,NBits,Max} = + {Min,NBits0,Max} = proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN, ?DEFAULT_DH_GROUP_NBITS, ?DEFAULT_DH_GROUP_MAX}), + DhBits = dh_bits(Ssh0#ssh.algorithms), + NBits1 = + %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management + if + DhBits =< 112 -> 2048; + DhBits =< 128 -> 3072; + DhBits =< 192 -> 7680; + true -> 8192 + end, + NBits = min(max(max(NBits0,NBits1),Min), Max), + {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min, n = NBits, @@ -350,12 +360,13 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ; %%% diffie-hellman-group14-sha1 %%% handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, - Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) -> + Ssh0 = #ssh{algorithms = #alg{kex=Kex} = Algs}) -> %% server {G, P} = dh_group(Kex), if 1=<E, E=<(P-1) -> - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), K = compute_key(dh, E, Private, [P,G]), MyPrivHostKey = get_host_key(Ssh0), MyPubHostKey = extract_public_key(MyPrivHostKey), @@ -426,13 +437,12 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, - keyex_info = {Min, Max, NBits} + Ssh#ssh{keyex_key = {x, {G, P}}, + keyex_info = {Min0, Max0, NBits} }}; {error,_} -> ssh_connection_handler:disconnect( @@ -461,12 +471,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, + Ssh#ssh{keyex_key = {x, {G, P}}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> @@ -507,7 +516,8 @@ adjust_gex_min_max(Min0, Max0, Opts) -> handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> %% client - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def) @@ -1117,6 +1127,51 @@ verify(PlainText, Hash, Sig, Key) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Unit: bytes + +-record(cipher_data, { + key_bytes, + iv_bytes, + block_bytes + }). + +%%% Start of a more parameterized crypto handling. +cipher('AEAD_AES_128_GCM') -> + #cipher_data{key_bytes = 16, + iv_bytes = 12, + block_bytes = 16}; + +cipher('AEAD_AES_256_GCM') -> + #cipher_data{key_bytes = 32, + iv_bytes = 12, + block_bytes = 16}; + +cipher('3des-cbc') -> + #cipher_data{key_bytes = 24, + iv_bytes = 8, + block_bytes = 8}; + +cipher('aes128-cbc') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes128-ctr') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes192-ctr') -> + #cipher_data{key_bytes = 24, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes256-ctr') -> + #cipher_data{key_bytes = 32, + iv_bytes = 16, + block_bytes = 16}. + + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> @@ -1497,11 +1552,11 @@ send_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "E", KeySize), {ok, SSH#ssh { send_mac_key = Key }}; server -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "F", KeySize), {ok, SSH#ssh { send_mac_key = Key }} end; @@ -1520,10 +1575,10 @@ recv_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - Key = hash(SSH, "F", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "F", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }}; server -> - Key = hash(SSH, "E", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }} end; aead -> @@ -1640,13 +1695,15 @@ sha(?'secp384r1') -> sha(secp384r1); sha(?'secp521r1') -> sha(secp521r1). -mac_key_size('hmac-sha1') -> 20*8; -mac_key_size('hmac-sha1-96') -> 20*8; -mac_key_size('hmac-md5') -> 16*8; -mac_key_size('hmac-md5-96') -> 16*8; -mac_key_size('hmac-sha2-256')-> 32*8; -mac_key_size('hmac-sha2-512')-> 512; -mac_key_size(none) -> 0. +mac_key_bytes('hmac-sha1') -> 20; +mac_key_bytes('hmac-sha1-96') -> 20; +mac_key_bytes('hmac-md5') -> 16; +mac_key_bytes('hmac-md5-96') -> 16; +mac_key_bytes('hmac-sha2-256')-> 32; +mac_key_bytes('hmac-sha2-512')-> 64; +mac_key_bytes('AEAD_AES_128_GCM') -> 0; +mac_key_bytes('AEAD_AES_256_GCM') -> 0; +mac_key_bytes(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; @@ -1671,6 +1728,13 @@ dh_group('diffie-hellman-group1-sha1') -> ?dh_group1; dh_group('diffie-hellman-group14-sha1') -> ?dh_group14. %%%---------------------------------------------------------------- +parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}}, + algorithms = Algs}) -> + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), + Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}. + + generate_key(Algorithm, Args) -> {Public,Private} = crypto:generate_key(Algorithm, Args), {crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}. @@ -1681,6 +1745,15 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> crypto:bytes_to_integer(Shared). +dh_bits(#alg{encrypt = Encrypt, + send_mac = SendMac}) -> + C = cipher(Encrypt), + 8 * lists:max([C#cipher_data.key_bytes, + C#cipher_data.block_bytes, + C#cipher_data.iv_bytes, + mac_key_bytes(SendMac) + ]). + ecdh_curve('ecdh-sha2-nistp256') -> secp256r1; ecdh_curve('ecdh-sha2-nistp384') -> secp384r1; ecdh_curve('ecdh-sha2-nistp521') -> secp521r1. diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index dc3b7dc7e6..8ca29b9399 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -54,15 +54,18 @@ -endif. -endif. +%% Public key records: +-include_lib("public_key/include/public_key.hrl"). %%% Properties: prop_ssh_decode() -> - ?FORALL(Msg, ssh_msg(), - try ssh_message:decode(Msg) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + try ssh_message:decode(decode_state(Msg,KexFam)) of _ -> true catch + C:E -> io:format('~p:~p~n',[C,E]), false end @@ -71,122 +74,101 @@ prop_ssh_decode() -> %%% This fails because ssh_message is not symmetric in encode and decode regarding data types prop_ssh_decode_encode() -> - ?FORALL(Msg, ssh_msg(), - Msg == ssh_message:encode(ssh_message:decode(Msg)) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + Msg == ssh_message:encode( + fix_asym( + ssh_message:decode(decode_state(Msg,KexFam)))) ). %%%================================================================ %%% -%%% Scripts to generate message generators -%%% - -%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt - -%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt - -%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt - -%%%================================================================ -%%% %%% Generators %%% -ssh_msg() -> ?LET(M,oneof( -[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], -%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_IGNORE'),gen_string( )], - %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], - %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], - %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], - [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], - [msg_code('SSH_MSG_NEWKEYS')], - [msg_code('SSH_MSG_REQUEST_FAILURE')], - [msg_code('SSH_MSG_REQUEST_SUCCESS')], - [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], - [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], - [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], - [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], - [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_SUCCESS')] -] - -), list_to_binary(M)). - - -%%%================================================================ -%%% -%%% Generator -%%% - -do() -> - io_lib:format('[~s~n]', - [write_gen( - files(["rfc4254.txt", - "rfc4253.txt", - "rfc4419.txt", - "rfc4252.txt", - "rfc4256.txt"]))]). - - -write_gen(L) when is_list(L) -> - string:join(lists:map(fun write_gen/1, L), ",\n "); -write_gen({MsgName,Args}) -> - lists:flatten(["[",generate_args([MsgName|Args]),"]"]). - -generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). - -generate_arg({<<"string">>, <<"\"",B/binary>>}) -> - S = get_string($",B), - ["gen_string(\"",S,"\")"]; -generate_arg({<<"string">>, _}) -> "gen_string( )"; -generate_arg({<<"byte[",B/binary>>, _}) -> - io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); -generate_arg({<<"byte">> ,_}) -> "gen_byte()"; -generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; -generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; -generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; -generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; -generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; -generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; -generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; -generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; -generate_arg({<<"....">>,_}) -> ""; %% FIXME -generate_arg(Name) when is_binary(Name) -> - lists:flatten(["msg_code('",binary_to_list(Name),"')"]). - +ssh_msg(<<"dh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEXDH_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + +ssh_msg(<<"dh_gex">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST_OLD'),gen_uint32()], % 30 + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + + ssh_msg(<<"ecdh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_ECDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEX_ECDH_REPLY'),gen_pubkey_string(ecdsa),gen_mpint(),gen_signature_string(ecdsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)). + + +rest_ssh_msgs() -> + [%% SSH_MSG_USERAUTH_INFO_RESPONSE + %% hard args SSH_MSG_USERAUTH_INFO_REQUEST + %% rfc4252 p12 error SSH_MSG_USERAUTH_REQUEST + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST'),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_INIT'),gen_mpint()], + [msg_code('SSH_MSG_KEX_DH_GEX_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)], + [msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] + ]. + +kex_family() -> oneof([<<"dh">>, <<"dh_gex">>, <<"ecdh">>]). gen_boolean() -> choose(0,1). @@ -202,10 +184,7 @@ gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. gen_char() -> choose($a,$z). -gen_mpint() -> ?LET(Size, choose(1,20), - ?LET(Str, vector(Size, gen_byte()), - gen_string( strip_0s(Str) ) - )). +gen_mpint() -> ?LET(I, largeint(), ssh_bits:mpint(I)). strip_0s([0|T]) -> strip_0s(T); strip_0s(X) -> X. @@ -230,13 +209,22 @@ gen_name() -> gen_string(). uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). -%%%---- -get_string(Delim, B) -> - binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). - -count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; -count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). +gen_pubkey_string(Type) -> + PubKey = case Type of + rsa -> #'RSAPublicKey'{modulus = 12345,publicExponent = 2}; + ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]}, + {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256 + end, + gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)). + +gen_signature_string(Type) -> + Signature = <<"hejhopp">>, + Id = case Type of + rsa -> "ssh-rsa"; + ecdsa -> "ecdsa-sha2-nistp256" + end, + gen_string(gen_string(Id) ++ gen_string(Signature)). -define(MSG_CODE(Name,Num), msg_code(Name) -> Num; @@ -273,124 +261,34 @@ msg_code(Num) -> Name ?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEXDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEXDH_REPLY', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); -?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). - -%%%============================================================================= -%%%============================================================================= -%%%============================================================================= - -files(Fs) -> - Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), - DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), - WantedIDs = lists:usort(wanted_messages()), - Missing = WantedIDs -- DefinedIDs, - case Missing of - [] -> ok; - _ -> io:format('%% Warning: missing ~p~n', [Missing]) - end, - Defs. - - -file(F) -> - {ok,B} = file:read_file(F), - hunt_msg_def(B). - - -hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); -hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); -hunt_msg_def(<<>>) -> []. - -some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); -some_hope(B) -> hunt_msg_def(B). - -try_message(B = <<"SSH_MSG_",_/binary>>) -> - {ID,Rest} = get_id(B), - case lists:member(binary_to_list(ID), wanted_messages()) of - true -> - {Lines,More} = get_def_lines(skip_blanks(Rest), []), - [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; - false -> - hunt_msg_def(Rest) - end; -try_message(B) -> hunt_msg_def(B). - - -skip_blanks(<<32, B/binary>>) -> skip_blanks(B); -skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); -skip_blanks(B) -> B. - -get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> - {ID,Rest} = get_id(skip_blanks(B)), - case {size(ID), skip_blanks(Rest)} of - {0,<<"....",More/binary>>} -> - {Text,LineEnd} = get_to_eol(skip_blanks(More)), - get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); - {0,_} -> - {Acc,B0}; - {_,Rest1} -> - {Text,LineEnd} = get_to_eol(Rest1), - get_def_lines(LineEnd, [{ID,Text}|Acc]) - end; -get_def_lines(B, Acc) -> - {Acc,B}. - - -get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). - -count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; -count_to_eol(<<>>, Acc) -> Acc; -count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). - - -get_id(B) -> split_binary(B, count_id_chars(B,0)). - -count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); -count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); -count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list -count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(_, Acc) -> Acc. - -wanted_messages() -> - ["SSH_MSG_CHANNEL_CLOSE", - "SSH_MSG_CHANNEL_DATA", - "SSH_MSG_CHANNEL_EOF", - "SSH_MSG_CHANNEL_EXTENDED_DATA", - "SSH_MSG_CHANNEL_FAILURE", - "SSH_MSG_CHANNEL_OPEN", - "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", - "SSH_MSG_CHANNEL_OPEN_FAILURE", - "SSH_MSG_CHANNEL_REQUEST", - "SSH_MSG_CHANNEL_SUCCESS", - "SSH_MSG_CHANNEL_WINDOW_ADJUST", - "SSH_MSG_DEBUG", - "SSH_MSG_DISCONNECT", - "SSH_MSG_GLOBAL_REQUEST", - "SSH_MSG_IGNORE", - "SSH_MSG_KEXDH_INIT", - "SSH_MSG_KEXDH_REPLY", - "SSH_MSG_KEXINIT", - "SSH_MSG_KEX_DH_GEX_GROUP", - "SSH_MSG_KEX_DH_GEX_REQUEST", - "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", - "SSH_MSG_NEWKEYS", - "SSH_MSG_REQUEST_FAILURE", - "SSH_MSG_REQUEST_SUCCESS", - "SSH_MSG_SERVICE_ACCEPT", - "SSH_MSG_SERVICE_REQUEST", - "SSH_MSG_UNIMPLEMENTED", - "SSH_MSG_USERAUTH_BANNER", - "SSH_MSG_USERAUTH_FAILURE", -%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", -%% "SSH_MSG_USERAUTH_INFO_RESPONSE", - "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", - "SSH_MSG_USERAUTH_PK_OK", -%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", - "SSH_MSG_USERAUTH_SUCCESS"]. +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33); +?MSG_CODE('SSH_MSG_KEX_ECDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEX_ECDH_REPLY', 31). + +%%%==================================================== +%%%=== WARNING: Knowledge of the test object ahead! === +%%%==================================================== + +%% SSH message records: +-include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). + +%%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :( +fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)}; +fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D), + language = binary_to_list(L)}; +fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>}; +fix_asym(M) -> M. + +%%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder +%%% input as the test object does +decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(<<31,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(Msg, _) -> Msg. diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 8b2db0e1a8..6f75d83c4a 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -58,9 +58,11 @@ groups() -> || {Tag,Algs} <- ErlAlgos, lists:member(Tag,tags()) ], + + TypeSSH = ssh_test_lib:ssh_type(), AlgoTcSet = - [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos)} + [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos,TypeSSH)} || {Tag,Algs} <- ErlAlgos ++ DoubleAlgos, Alg <- Algs], @@ -198,18 +200,17 @@ try_exec_simple_group(Group, Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{minutes,5}}]. - +simple_exec_groups() -> + [{timetrap,{seconds,120}}]. + simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), lists:foreach( fun(Sz) -> ct:log("Try size ~p",[Sz]), ct:comment(Sz), - case simple_exec_group(Sz, Config) of - expected -> ct:log("Size ~p ok",[Sz]); - _ -> ct:log("Size ~p not ok",[Sz]) - end + simple_exec_group(Sz, Config), + ct:log("Size ~p ok",[Sz]) end, Sizes), ct:comment("~p",[lists:map(fun({_,I,_}) -> I; (I) -> I @@ -317,18 +318,13 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])). split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")). -specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos) -> +specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) -> [simple_exec, simple_sftp] ++ case supports(Tag, Alg, SshcAlgos) of - true -> - case ssh_test_lib:ssh_type() of - openSSH -> - [sshc_simple_exec_os_cmd]; - _ -> - [] - end; - false -> - [] + true when TypeSSH == openSSH -> + [sshc_simple_exec_os_cmd]; + _ -> + [] end ++ case supports(Tag, Alg, SshdAlgos) of true -> diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index c2bfc48449..c5a6447839 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, - {timetrap,{minutes,3}} + {timetrap,{minutes,6}} ]. %%suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 8f060bebd8..d07c596411 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -67,7 +67,8 @@ hostkey_fingerprint_check_sha/1, hostkey_fingerprint_check_sha256/1, hostkey_fingerprint_check_sha384/1, - hostkey_fingerprint_check_sha512/1 + hostkey_fingerprint_check_sha512/1, + hostkey_fingerprint_check_list/1 ]). %%% Common test callbacks @@ -112,6 +113,7 @@ all() -> hostkey_fingerprint_check_sha256, hostkey_fingerprint_check_sha384, hostkey_fingerprint_check_sha512, + hostkey_fingerprint_check_list, id_string_no_opt_client, id_string_own_string_client, id_string_random_client, @@ -812,6 +814,8 @@ hostkey_fingerprint_check_sha384(Config) -> hostkey_fingerprint_check_sha512(Config) -> do_hostkey_fingerprint_check(Config, sha512). +hostkey_fingerprint_check_list(Config) -> + do_hostkey_fingerprint_check(Config, [sha,md5,sha256]). %%%---- do_hostkey_fingerprint_check(Config, HashAlg) -> @@ -824,20 +828,24 @@ do_hostkey_fingerprint_check(Config, HashAlg) -> supported_hash(old) -> true; supported_hash(HashAlg) -> - proplists:get_value(HashAlg, - proplists:get_value(hashs, crypto:supports(), []), - false). + Hs = if is_atom(HashAlg) -> [HashAlg]; + is_list(HashAlg) -> HashAlg + end, + [] == (Hs -- proplists:get_value(hashs, crypto:supports(), [])). really_do_hostkey_fingerprint_check(Config, HashAlg) -> PrivDir = proplists:get_value(priv_dir, Config), - UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth - file:make_dir(UserDir), + UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDirServer), SysDir = proplists:get_value(data_dir, Config), + UserDirClient = + ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs + %% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint %% function since that function is used by the ssh client... - FPs = [case HashAlg of + FPs0 = [case HashAlg of old -> public_key:ssh_hostkey_fingerprint(Key); _ -> public_key:ssh_hostkey_fingerprint(HashAlg, Key) end @@ -853,18 +861,25 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> _:_ -> [] end end], + FPs = if is_atom(HashAlg) -> FPs0; + is_list(HashAlg) -> lists:concat(FPs0) + end, ct:log("Fingerprints(~p) = ~p",[HashAlg,FPs]), %% Start daemon with the public keys that we got fingerprints from {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, + {user_dir, UserDirServer}, {password, "morot"}]), FP_check_fun = fun(PeerName, FP) -> ct:pal("PeerName = ~p, FP = ~p",[PeerName,FP]), HostCheck = (Host == PeerName), - FPCheck = lists:member(FP, FPs), - ct:log("check ~p == ~p (~p) and ~n~p in ~p (~p)~n", + FPCheck = + if is_atom(HashAlg) -> lists:member(FP, FPs); + is_list(HashAlg) -> lists:all(fun(FP1) -> lists:member(FP1,FPs) end, + FP) + end, + ct:log("check ~p == ~p (~p) and ~n~p~n in ~p (~p)~n", [PeerName,Host,HostCheck,FP,FPs,FPCheck]), HostCheck and FPCheck end, @@ -876,7 +891,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> end}, {user, "foo"}, {password, "morot"}, - {user_dir, UserDir}, + {user_dir, UserDirClient}, {user_interaction, false}]), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 7ba2732a88..9b2a84d8e4 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -68,9 +68,6 @@ init_per_group(_, Config) -> end_per_group(_, Config) -> Config. -%%% Always skip the testcase that is not quite in phase with the -%%% ssh_message.erl code -init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; init_per_testcase(_TestCase, Config) -> Config. end_per_testcase(_TestCase, Config) -> Config. diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 93d0bc2eb0..f9edc5bfc2 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -107,7 +107,10 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; TC == gex_client_old_request_noexact -> Opts = case TC of gex_client_init_option_groups -> - [{dh_gex_groups, [{2345, 3, 41}]}]; + [{dh_gex_groups, + [{1023, 5, + 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F + }]}]; gex_client_init_option_groups_file -> DataDir = proplists:get_value(data_dir, Config), F = filename:join(DataDir, "dh_group_test"), @@ -119,10 +122,12 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; _ when TC == gex_server_gex_limit ; TC == gex_client_old_request_exact ; TC == gex_client_old_request_noexact -> - [{dh_gex_groups, [{ 500, 3, 17}, - {1000, 7, 91}, - {3000, 5, 61}]}, - {dh_gex_limits,{500,1500}} + [{dh_gex_groups, + [{1023, 2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323}, + {1535, 5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}, + {3071, 2, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9429825A2B} + ]}, + {dh_gex_limits, {1023,2000}} ]; _ -> [] @@ -351,20 +356,25 @@ no_common_alg_client_disconnects(Config) -> %%%-------------------------------------------------------------------- gex_client_init_option_groups(Config) -> - do_gex_client_init(Config, {2000, 2048, 4000}, - {3,41}). + do_gex_client_init(Config, {512, 2048, 4000}, + {5,16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F} + ). gex_client_init_option_groups_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,61}). + {5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F} + ). gex_client_init_option_groups_moduli_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,16#B7}). + {5, 16#DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F} + ). gex_server_gex_limit(Config) -> do_gex_client_init(Config, {1000, 3000, 4000}, - {7,91}). + %% {7,91}). + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> @@ -390,8 +400,15 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> ). %%%-------------------------------------------------------------------- -gex_client_old_request_exact(Config) -> do_gex_client_init_old(Config, 500, {3,17}). -gex_client_old_request_noexact(Config) -> do_gex_client_init_old(Config, 800, {7,91}). +gex_client_old_request_exact(Config) -> + do_gex_client_init_old(Config, 1023, + {2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323} + ). + +gex_client_old_request_noexact(Config) -> + do_gex_client_init_old(Config, 1400, + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init_old(Config, N, {G,P}) -> {ok,_} = diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test index 2887bb4b60..87c4b4afc8 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test @@ -1,3 +1,3 @@ -{2222, 5, 61}. -{1111, 7, 91}. +{1023, 5, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}. +{3071, 5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}. diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli index f6995ba4c9..6d2b4bcb59 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli @@ -1,3 +1,2 @@ -20151021104105 2 6 100 2222 5 B7 -20151021104106 2 6 100 1111 5 4F - +20120821044046 2 6 100 1023 2 D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A7711F2C6B +20120821050554 2 6 100 2047 5 DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 70662f5d93..acf76157a2 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -1038,7 +1038,7 @@ oldprep(Config) -> prepare(Config0) -> PrivDir = proplists:get_value(priv_dir, Config0), - Dir = filename:join(PrivDir, random_chars(10)), + Dir = filename:join(PrivDir, ssh_test_lib:random_chars(10)), file:make_dir(Dir), Keys = [filename, testfile, @@ -1058,8 +1058,6 @@ prepare(Config0) -> [{sftp_priv_dir,Dir} | Config2]. -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. - foldl_keydelete(Keys, L) -> lists:foldl(fun(K,E) -> lists:keydelete(K,1,E) end, L, diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 52a26110c4..6d18a980ee 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -65,7 +65,12 @@ all() -> ver3_open_flags, relpath, sshd_read_file, - ver6_basic]. + ver6_basic, + access_outside_root, + root_with_cwd, + relative_path, + open_file_dir_v5, + open_file_dir_v6]. groups() -> []. @@ -117,6 +122,31 @@ init_per_testcase(TestCase, Config) -> ver6_basic -> SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])], ssh:daemon(0, [{subsystems, SubSystems}|Options]); + access_outside_root -> + %% Build RootDir/access_outside_root/a/b and set Root and CWD + BaseDir = filename:join(PrivDir, access_outside_root), + RootDir = filename:join(BaseDir, a), + CWD = filename:join(RootDir, b), + %% Make the directory chain: + ok = filelib:ensure_dir(filename:join(CWD, tmp)), + SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir}, + {cwd, CWD}])], + ssh:daemon(0, [{subsystems, SubSystems}|Options]); + root_with_cwd -> + RootDir = filename:join(PrivDir, root_with_cwd), + CWD = filename:join(RootDir, home), + SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir}, {cwd, CWD}])], + ssh:daemon(0, [{subsystems, SubSystems}|Options]); + relative_path -> + SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])], + ssh:daemon(0, [{subsystems, SubSystems}|Options]); + open_file_dir_v5 -> + SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])], + ssh:daemon(0, [{subsystems, SubSystems}|Options]); + open_file_dir_v6 -> + SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}, + {sftpd_vsn, 6}])], + ssh:daemon(0, [{subsystems, SubSystems}|Options]); _ -> SubSystems = [ssh_sftpd:subsystem_spec([])], ssh:daemon(0, [{subsystems, SubSystems}|Options]) @@ -646,6 +676,133 @@ ver6_basic(Config) when is_list(Config) -> open_file(PrivDir, Cm, Channel, ReqId, ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, ?SSH_FXF_OPEN_EXISTING). + +%%-------------------------------------------------------------------- +access_outside_root() -> + [{doc, "Try access files outside the tree below RootDir"}]. +access_outside_root(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + BaseDir = filename:join(PrivDir, access_outside_root), + %% A file outside the tree below RootDir which is BaseDir/a + %% Make the file BaseDir/bad : + BadFilePath = filename:join([BaseDir, bad]), + ok = file:write_file(BadFilePath, <<>>), + {Cm, Channel} = proplists:get_value(sftp, Config), + %% Try to access a file parallell to the RootDir: + try_access("/../bad", Cm, Channel, 0), + %% Try to access the same file via the CWD which is /b relative to the RootDir: + try_access("../../bad", Cm, Channel, 1). + + +try_access(Path, Cm, Channel, ReqId) -> + Return = + open_file(Path, Cm, Channel, ReqId, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING), + ct:log("Try open ~p -> ~p",[Path,Return]), + case Return of + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle0/binary>>, _} -> + ct:fail("Could open a file outside the root tree!"); + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(Code), Rest/binary>>, <<>>} -> + case Code of + ?SSH_FX_FILE_IS_A_DIRECTORY -> + ct:pal("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]), + ok; + ?SSH_FX_FAILURE -> + ct:pal("Got the expected SSH_FX_FAILURE status",[]), + ok; + _ -> + case Rest of + <<?UINT32(Len), Txt:Len/binary, _/binary>> -> + ct:fail("Got unexpected SSH_FX_code: ~p (~p)",[Code,Txt]); + _ -> + ct:fail("Got unexpected SSH_FX_code: ~p",[Code]) + end + end; + _ -> + ct:fail("Completly unexpected return: ~p", [Return]) + end. + +%%-------------------------------------------------------------------- +root_with_cwd() -> + [{doc, "Check if files are found, if the CWD and Root are specified"}]. +root_with_cwd(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + RootDir = filename:join(PrivDir, root_with_cwd), + CWD = filename:join(RootDir, home), + FileName = "root_with_cwd.txt", + FilePath = filename:join(CWD, FileName), + ok = filelib:ensure_dir(FilePath), + ok = file:write_file(FilePath ++ "0", <<>>), + ok = file:write_file(FilePath ++ "1", <<>>), + ok = file:write_file(FilePath ++ "2", <<>>), + {Cm, Channel} = proplists:get_value(sftp, Config), + ReqId0 = 0, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId0), _Handle0/binary>>, _} = + open_file(FileName ++ "0", Cm, Channel, ReqId0, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING), + ReqId1 = 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId1), _Handle1/binary>>, _} = + open_file("./" ++ FileName ++ "1", Cm, Channel, ReqId1, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING), + ReqId2 = 2, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId2), _Handle2/binary>>, _} = + open_file("/home/" ++ FileName ++ "2", Cm, Channel, ReqId2, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING). + +%%-------------------------------------------------------------------- +relative_path() -> + [{doc, "Test paths relative to CWD when opening a file handle."}]. +relative_path(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + FileName = "test_relative_path.txt", + FilePath = filename:join(PrivDir, FileName), + ok = filelib:ensure_dir(FilePath), + ok = file:write_file(FilePath, <<>>), + {Cm, Channel} = proplists:get_value(sftp, Config), + ReqId = 0, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle/binary>>, _} = + open_file(FileName, Cm, Channel, ReqId, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING). + +%%-------------------------------------------------------------------- +open_file_dir_v5() -> + [{doc, "Test if open_file fails when opening existing directory."}]. +open_file_dir_v5(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + FileName = "open_file_dir_v5", + FilePath = filename:join(PrivDir, FileName), + ok = filelib:ensure_dir(FilePath), + ok = file:make_dir(FilePath), + {Cm, Channel} = proplists:get_value(sftp, Config), + ReqId = 0, + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} = + open_file(FileName, Cm, Channel, ReqId, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING). + +%%-------------------------------------------------------------------- +open_file_dir_v6() -> + [{doc, "Test if open_file fails when opening existing directory."}]. +open_file_dir_v6(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + FileName = "open_file_dir_v6", + FilePath = filename:join(PrivDir, FileName), + ok = filelib:ensure_dir(FilePath), + ok = file:make_dir(FilePath), + {Cm, Channel} = proplists:get_value(sftp, Config), + ReqId = 0, + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_FILE_IS_A_DIRECTORY), _/binary>>, _} = + open_file(FileName, Cm, Channel, ReqId, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -688,9 +845,7 @@ reply(Cm, Channel, RBuf) -> 30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE]) end. - open_file(File, Cm, Channel, ReqId, Access, Flags) -> - Data = list_to_binary([?uint32(ReqId), ?binary(list_to_binary(File)), ?uint32(Access), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index f93237f3e7..1673f52821 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -113,19 +113,27 @@ std_simple_exec(Host, Port, Config) -> std_simple_exec(Host, Port, Config, []). std_simple_exec(Host, Port, Config, Opts) -> + ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]), ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), + ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ok; - Other -> - ct:fail(Other) - end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - ssh:close(ConnectionRef). - + ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]), + ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), + ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]), + case ExecResult of + success -> + Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42\n">>}}, + case receive_exec_result(Expected) of + expected -> + ok; + Other -> + ct:fail(Other) + end, + receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef); + _ -> + ct:fail(ExecResult) + end. start_shell(Port, IOServer) -> start_shell(Port, IOServer, []). @@ -682,13 +690,16 @@ ssh_type() -> ssh_type1() -> try + ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]), case os:find_executable("ssh") of false -> ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]), not_found; - _ -> + Path -> + ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]), case os:cmd("ssh -V") of - "OpenSSH" ++ _ -> + Version = "OpenSSH" ++ _ -> + ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]), openSSH; Str -> ct:log("ssh client ~p is unknown",[Str]), @@ -834,3 +845,20 @@ get_kex_init(Conn, Ref, TRef) -> end end. +%%%---------------------------------------------------------------- +%%% Return a string with N random characters +%%% +random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. + + +create_random_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Name = filename:join(PrivDir, random_chars(15)), + case file:make_dir(Name) of + ok -> + Name; + {error,eexist} -> + %% The Name already denotes an existing file system object, try again. + %% The likelyhood of always generating an existing file name is low + create_random_dir(Config) + end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 86c3d5de26..0b9b7acde8 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -36,7 +36,7 @@ %%-------------------------------------------------------------------- suite() -> - [{timetrap,{seconds,20}}]. + [{timetrap,{seconds,60}}]. all() -> case os:find_executable("ssh") of @@ -464,6 +464,7 @@ erlang_client_openssh_server_renegotiate(_Config) -> {silently_accept_hosts,true}], group_leader(IO, self()), {ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options), + ct:pal("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]), case ssh_connection:session_channel(ConnRef, infinity) of {ok,ChannelId} -> success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []), diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index b5b27c369a..7b9b109fa1 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -199,6 +199,4 @@ close(#state{server = Server, connection = undefined}. -random_contents() -> list_to_binary( random_chars(3) ). - -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. +random_contents() -> list_to_binary( ssh_test_lib:random_chars(3) ). diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index edc7e0d8b2..916b41742e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid </taglist> </item> + + <tag><c>max_handshake_size</c></tag> + <item> + <p>Integer (24 bits unsigned). Used to limit the size of + valid TLS handshake packets to avoid DoS attacks. + Defaults to 256*1024.</p> + </item> + </taglist> </item> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index b85d8fb284..1b41eae89d 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -11,7 +11,7 @@ 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 @@ -62,8 +62,8 @@ </taglist> </section> - - <funcs> + + <funcs> <func> <name>delete(Cache, Key) -> _</name> @@ -134,7 +134,7 @@ </p> </desc> </func> - + <func> <name>select_session(Cache, PartialKey) -> [session()]</name> <fsummary>Selects sessions that can be reused.</fsummary> @@ -151,6 +151,21 @@ </func> <func> + <name>size(Cache) -> integer()</name> + <fsummary>Returns the number of sessions in the cache.</fsummary> + <type> + <v>Cache = cache_ref()</v> + </type> + <desc> + <p>Returns the number of sessions in the cache. If size + exceeds the maximum number of sessions, the current cache + entries will be invalidated regardless of their remaining + lifetime. Is to be callable from any process. + </p> + </desc> + </func> + + <func> <name>terminate(Cache) -> _</name> <fsummary>Called by the process that handles the cache when it is about to terminate.</fsummary> @@ -178,7 +193,7 @@ </p> </desc> </func> - - </funcs> - + + </funcs> + </erlref> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 3dda1a3316..2e7df9792e 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -48,9 +48,17 @@ MODULES= \ dtls \ ssl_alert \ ssl_app \ - ssl_dist_sup\ ssl_sup \ + ssl_admin_sup\ + tls_connection_sup \ + ssl_connection_sup \ + ssl_listen_tracker_sup\ + dtls_connection_sup \ + dtls_udp_listener\ dtls_udp_sup \ + ssl_dist_sup\ + ssl_dist_admin_sup\ + ssl_dist_connection_sup\ inet_tls_dist \ inet6_tls_dist \ ssl_certificate\ @@ -61,21 +69,18 @@ MODULES= \ dtls_connection \ ssl_config \ ssl_connection \ - tls_connection_sup \ - dtls_connection_sup \ tls_handshake \ dtls_handshake\ ssl_handshake\ ssl_manager \ ssl_session \ ssl_session_cache \ + ssl_pem_cache \ ssl_crl\ ssl_crl_cache \ ssl_crl_hash_dir \ tls_socket \ dtls_socket \ - dtls_udp_listener\ - ssl_listen_tracker_sup \ tls_record \ dtls_record \ ssl_record \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 070a90d481..f607c86ae3 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -39,7 +39,7 @@ -export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_event/3]). +-export([next_record/1, next_event/3, next_event/4]). %% Handshake handling -export([renegotiate/2, @@ -53,7 +53,7 @@ %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, - send/3]). + send/3, socket/5]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -77,20 +77,6 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} catch error:{badmatch, {error, _} = Error} -> Error - end; - -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, - Timeout) -> - try - {ok, Pid} = dtls_connection_sup:start_child_dist([Role, Host, Port, Socket, - Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), - ok = ssl_connection:handshake(SslSocket, Timeout), - {ok, SslSocket} - catch - error:{badmatch, {error, _} = Error} -> - Error end. send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) -> @@ -201,6 +187,7 @@ reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> State#state{premaster_secret = undefined, public_key_info = undefined, tls_handshake_history = ssl_handshake:init_handshake_history(), + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, protocol_buffers = Buffers#protocol_buffers{ dtls_handshake_next_seq = 0, @@ -213,6 +200,9 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) -> select_sni_extension(_) -> undefined. +socket(Pid, Transport, Socket, Connection, _) -> + dtls_socket:socket(Pid, Transport, Socket, Connection). + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -243,7 +233,7 @@ callback_mode() -> state_functions. %%-------------------------------------------------------------------- -%% State functionsconnection/2 +%% State functions %%-------------------------------------------------------------------- init({call, From}, {start, Timeout}, @@ -262,17 +252,19 @@ init({call, From}, {start, Timeout}, Version = Hello#client_hello.client_version, HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), State1 = prepare_flight(State0#state{negotiated_version = Version}), - State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, start_or_recv_from = From, - timer = Timer}, + timer = Timer, + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} + }, {Record, State} = next_record(State3), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) -> ssl_connection:init(Type, Event, - State#state{flight_state = {waiting, undefined, ?INITIAL_RETRANSMIT_TIMEOUT}}, + State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}}, ?MODULE); init({call, _} = Type, Event, #state{role = server} = State) -> %% I.E. DTLS over sctp @@ -302,9 +294,9 @@ hello(internal, #client_hello{cookie = <<>>, Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello), VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version), State1 = prepare_flight(State0#state{negotiated_version = Version}), - State2 = send_handshake(VerifyRequest, State1), + {State2, Actions} = send_handshake(VerifyRequest, State1), {Record, State} = next_record(State2), - next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}); + next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions); hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, transport_cb = Transport, socket = Socket} = State0) -> @@ -333,13 +325,13 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, Cache, CacheCb, Renegotiation, OwnCert), Version = Hello#client_hello.client_version, HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), - State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}}, {Record, State} = next_record(State3), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, @@ -356,13 +348,13 @@ hello(internal, #server_hello{} = Hello, hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, State) -> %% Initial hello should not be in handshake history {next_state, hello, State, [{next_event, internal, Handshake}]}; - hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) -> %% hello_verify should not be in handshake history {next_state, hello, State, [{next_event, internal, Handshake}]}; - hello(info, Event, State) -> handle_info(Event, hello, State); +hello(state_timeout, Event, State) -> + handle_state_timeout(Event, hello, State); hello(Type, Event, State) -> ssl_connection:hello(Type, Event, State, ?MODULE). @@ -375,7 +367,11 @@ abbreviated(internal = Type, ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read), ssl_connection:abbreviated(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> - ssl_connection:cipher(Type, Event, prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); + ssl_connection:abbreviated(Type, Event, + prepare_flight(State#state{connection_states = ConnectionStates, + flight_state = connection}), ?MODULE); +abbreviated(state_timeout, Event, State) -> + handle_state_timeout(Event, abbreviated, State); abbreviated(Type, Event, State) -> ssl_connection:abbreviated(Type, Event, State, ?MODULE). @@ -383,6 +379,8 @@ certify(info, Event, State) -> handle_info(Event, certify, State); certify(internal = Type, #server_hello_done{} = Event, State) -> ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE); +certify(state_timeout, Event, State) -> + handle_state_timeout(Event, certify, State); certify(Type, Event, State) -> ssl_connection:certify(Type, Event, State, ?MODULE). @@ -395,7 +393,11 @@ cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event, ssl_connection:cipher(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> ssl_connection:cipher(Type, Event, - prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); + prepare_flight(State#state{connection_states = ConnectionStates, + flight_state = connection}), + ?MODULE); +cipher(state_timeout, Event, State) -> + handle_state_timeout(Event, cipher, State); cipher(Type, Event, State) -> ssl_connection:cipher(Type, Event, State, ?MODULE). @@ -409,12 +411,12 @@ connection(internal, #hello_request{}, #state{host = Host, port = Port, renegotiation = {Renegotiation, _}} = State0) -> Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), - State1 = send_handshake(Hello, State0), + {State1, Actions} = send_handshake(Hello, State0), {Record, State} = next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html @@ -434,7 +436,6 @@ connection(Type, Event, State) -> downgrade(Type, Event, State) -> ssl_connection:downgrade(Type, Event, State, ?MODULE). - %%-------------------------------------------------------------------- %% Description: This function is called by a gen_fsm when it receives any %% other message than a synchronous or asynchronous event @@ -442,16 +443,6 @@ downgrade(Type, Event, State) -> %%-------------------------------------------------------------------- %% raw data from socket, unpack records -handle_info({_,flight_retransmission_timeout}, connection, _) -> - {next_state, keep_state_and_data}; -handle_info({Ref, flight_retransmission_timeout}, StateName, - #state{flight_state = {waiting, Ref, NextTimeout}} = State0) -> - State1 = send_handshake_flight(State0#state{flight_state = {retransmit_timer, NextTimeout}}, - retransmit_epoch(StateName, State0)), - {Record, State} = next_record(State1), - next_event(StateName, Record, State); -handle_info({_, flight_retransmission_timeout}, _, _) -> - {next_state, keep_state_and_data}; handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> case next_dtls_record(Data, State0) of @@ -489,7 +480,6 @@ handle_call(Event, From, StateName, State) -> handle_common_event(internal, #alert{} = Alert, StateName, #state{negotiated_version = Version} = State) -> ssl_connection:handle_own_alert(Alert, Version, StateName, State); - %%% DTLS record protocol level handshake messages handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, @@ -498,19 +488,14 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, negotiated_version = Version} = State0) -> try case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of - {more_data, Buffers} -> + {[], Buffers} -> {Record, State} = next_record(State0#state{protocol_buffers = Buffers}), next_event(StateName, Record, State); {Packets, Buffers} -> State = State0#state{protocol_buffers = Buffers}, Events = dtls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, - State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + {next_state, StateName, + State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} end catch throw:#alert{} = Alert -> ssl_connection:handle_own_alert(Alert, Version, StateName, State0) @@ -534,6 +519,13 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> {next_state, StateName, State}. +handle_state_timeout(flight_retransmission_timeout, StateName, + #state{flight_state = {retransmit, NextTimeout}} = State0) -> + {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}}, + retransmit_epoch(StateName, State0)), + {Record, State} = next_record(State1), + next_event(StateName, Record, State, Actions). + send(Transport, {_, {{_,_}, _} = Socket}, Data) -> send(Transport, Socket, Data); send(Transport, Socket, Data) -> @@ -645,7 +637,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, protocol_cb = ?MODULE, - flight_buffer = new_flight() + flight_buffer = new_flight(), + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} }. next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ @@ -714,14 +707,14 @@ next_event(connection = StateName, no_record, #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> case next_record_if_active(State0) of {no_record, State} -> - ssl_connection:hibernate_after(StateName, State, Actions); + ssl_connection:hibernate_after(StateName, State, Actions); {#ssl_tls{epoch = CurrentEpoch} = Record, State} -> {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; {#ssl_tls{epoch = Epoch, type = ?HANDSHAKE, version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> - State = send_handshake_flight(State1, Epoch), - {next_state, StateName, State, Actions}; + {State, MoreActions} = send_handshake_flight(State1, Epoch), + {next_state, StateName, State, Actions ++ MoreActions}; {#ssl_tls{epoch = _Epoch, version = _Version}, State} -> %% TODO maybe buffer later epoch @@ -772,17 +765,20 @@ next_flight(Flight) -> Flight#{handshakes => [], change_cipher_spec => undefined, handshakes_after_change_cipher_spec => []}. - start_flight(#state{transport_cb = gen_udp, - flight_state = {retransmit_timer, Timeout}} = State) -> - Ref = erlang:make_ref(), - _ = erlang:send_after(Timeout, self(), {Ref, flight_retransmission_timeout}), - State#state{flight_state = {waiting, Ref, new_timeout(Timeout)}}; - + flight_state = {retransmit, Timeout}} = State) -> + start_retransmision_timer(Timeout, State); +start_flight(#state{transport_cb = gen_udp, + flight_state = connection} = State) -> + {State, []}; start_flight(State) -> %% No retransmision needed i.e DTLS over SCTP - State#state{flight_state = reliable}. + {State#state{flight_state = reliable}, []}. + +start_retransmision_timer(Timeout, State) -> + {State#state{flight_state = {retransmit, new_timeout(Timeout)}}, + [{state_timeout, Timeout, flight_retransmission_timeout}]}. new_timeout(N) when N =< 30 -> N * 2; @@ -806,13 +802,13 @@ renegotiate(#state{role = server, connection_states = CS0} = State0, Actions) -> HelloRequest = ssl_handshake:hello_request(), CS = CS0#{write_msg_seq => 0}, - State1 = send_handshake(HelloRequest, - State0#state{connection_states = - CS}), + {State1, MoreActions} = send_handshake(HelloRequest, + State0#state{connection_states = + CS}), Hs0 = ssl_handshake:init_handshake_history(), {Record, State} = next_record(State1#state{tls_handshake_history = Hs0, protocol_buffers = #protocol_buffers{}}), - next_event(hello, Record, State, Actions). + next_event(hello, Record, State, Actions ++ MoreActions). handle_alerts([], Result) -> Result; @@ -823,15 +819,11 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). -retransmit_epoch(StateName, #state{connection_states = ConnectionStates}) -> +retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) -> #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), - case StateName of - connection -> - Epoch-1; - _ -> - Epoch - end. + Epoch. + update_handshake_history(#hello_verify_request{}, _, Hist) -> Hist; @@ -846,3 +838,4 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index af3708ddb7..fd1f9698fe 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -136,9 +136,11 @@ handshake_bin([Type, Length, Data], Seq) -> %%-------------------------------------------------------------------- -spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) -> - {[{dtls_handshake(), binary()}], #protocol_buffers{}} | {more_data, #protocol_buffers{}}. + {[dtls_handshake()], #protocol_buffers{}}. %% -%% Description: ... +%% Description: Given buffered and new data from dtls_record, collects +%% and returns it as a list of handshake messages, also returns +%% possible leftover data in the new "protocol_buffers". %%-------------------------------------------------------------------- get_dtls_handshake(Version, Fragment, ProtocolBuffers) -> handle_fragments(Version, Fragment, ProtocolBuffers, []). @@ -288,8 +290,6 @@ do_handle_fragments(_, [], Buffers, Acc) -> {lists:reverse(Acc), Buffers}; do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) -> case reassemble(Version, Fragment, Buffers0) of - {more_data, _} = More when Acc == []-> - More; {more_data, Buffers} when Fragments == [] -> {lists:reverse(Acc), Buffers}; {more_data, Buffers} -> diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index 570b3ae83a..ac1a7b37c6 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -71,11 +71,14 @@ connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo, close(gen_udp, {_Client, _Socket}) -> ok. +socket(Pid, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) -> + #sslsocket{pid = Pid, + %% "The name "fd" is keept for backwards compatibility + fd = {Transport, Socket, ConnectionCb}}; socket(Pid, Transport, Socket, ConnectionCb) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility - fd = {Transport, Socket, ConnectionCb}}. - + fd = {Transport, Socket, ConnectionCb}}. %% Vad göra med emulerade setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) -> {SockOpts, _} = tls_socket:split_options(Options), @@ -108,11 +111,15 @@ getstat(gen_udp, {_,Socket}, Options) -> inet:getstat(Socket, Options); getstat(Transport, Socket, Options) -> Transport:getstat(Socket, Options). +peername(udp, _) -> + {error, enotconn}; peername(gen_udp, {_, {Client, _Socket}}) -> {ok, Client}; peername(Transport, Socket) -> Transport:peername(Socket). -sockname(gen_udp, {_,Socket}) -> +sockname(gen_udp, {_, {_,Socket}}) -> + inet:sockname(Socket); +sockname(gen_udp, Socket) -> inet:sockname(Socket); sockname(Transport, Socket) -> Transport:sockname(Socket). diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl index b7f115582e..ab3d0783bd 100644 --- a/lib/ssl/src/dtls_udp_listener.erl +++ b/lib/ssl/src/dtls_udp_listener.erl @@ -24,7 +24,8 @@ -behaviour(gen_server). %% API --export([start_link/4, active_once/3, accept/2, sockname/1]). +-export([start_link/4, active_once/3, accept/2, sockname/1, close/1, + get_all_opts/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -39,7 +40,8 @@ clients = set_new(), dtls_processes = kv_new(), accepters = queue:new(), - first + first, + close }). %%%=================================================================== @@ -53,10 +55,14 @@ active_once(UDPConnection, Client, Pid) -> gen_server:cast(UDPConnection, {active_once, Client, Pid}). accept(UDPConnection, Accepter) -> - gen_server:call(UDPConnection, {accept, Accepter}, infinity). + call(UDPConnection, {accept, Accepter}). sockname(UDPConnection) -> - gen_server:call(UDPConnection, sockname, infinity). + call(UDPConnection, sockname). +close(UDPConnection) -> + call(UDPConnection, close). +get_all_opts(UDPConnection) -> + call(UDPConnection, get_all_opts). %%%=================================================================== %%% gen_server callbacks @@ -69,10 +75,13 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) -> first = true, dtls_options = DTLSOptions, emulated_options = EmOpts, - listner = Socket}} + listner = Socket, + close = false}} catch _:_ -> {error, closed} end. +handle_call({accept, _}, _, #state{close = true} = State) -> + {reply, {error, closed}, State}; handle_call({accept, Accepter}, From, #state{first = true, accepters = Accepters, @@ -87,7 +96,21 @@ handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) -> {noreply, State}; handle_call(sockname, _, #state{listner = Socket} = State) -> Reply = inet:sockname(Socket), - {reply, Reply, State}. + {reply, Reply, State}; +handle_call(close, _, #state{dtls_processes = Processes, + accepters = Accepters} = State) -> + case kv_empty(Processes) of + true -> + {stop, normal, ok, State#state{close=true}}; + false -> + lists:foreach(fun({_, From}) -> + gen_server:reply(From, {error, closed}) + end, queue:to_list(Accepters)), + {reply, ok, State#state{close = true, accepters = queue:new()}} + end; +handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions, + emulated_options = EmOpts} = State) -> + {reply, {ok, EmOpts, DTLSOptions}, State}. handle_cast({active_once, Client, Pid}, State0) -> State = handle_active_once(Client, Pid, State0), @@ -99,11 +122,17 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta {noreply, State}; handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients, - dtls_processes = Processes0} = State) -> + dtls_processes = Processes0, + close = ListenClosed} = State) -> Client = kv_get(Pid, Processes0), Processes = kv_delete(Pid, Processes0), - {noreply, State#state{clients = set_delete(Client, Clients), - dtls_processes = Processes}}. + case ListenClosed andalso kv_empty(Processes) of + true -> + {stop, normal, State}; + false -> + {noreply, State#state{clients = set_delete(Client, Clients), + dtls_processes = Processes}} + end. terminate(_Reason, _State) -> ok. @@ -182,6 +211,7 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes, gen_server:reply(From, {error, Reason}), State end. + kv_update(Key, Value, Store) -> gb_trees:update(Key, Value, Store). kv_lookup(Key, Store) -> @@ -194,6 +224,8 @@ kv_delete(Key, Store) -> gb_trees:delete(Key, Store). kv_new() -> gb_trees:empty(). +kv_empty(Store) -> + gb_trees:is_empty(Store). set_new() -> gb_sets:empty(). @@ -203,3 +235,15 @@ set_delete(Item, Set) -> gb_sets:delete(Item, Set). set_is_member(Item, Set) -> gb_sets:is_member(Item, Set). + +call(Server, Msg) -> + try + gen_server:call(Server, Msg, infinity) + catch + exit:{noproc, _} -> + {error, closed}; + exit:{normal, _} -> + {error, closed}; + exit:{{shutdown, _},_} -> + {error, closed} + end. diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index ffd3e4b833..dd0d35d404 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -21,12 +21,21 @@ -include("ssl_cipher.hrl"). --export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1]). +-export([suites/1, all_suites/1, mac_hash/7, ecc_curves/1, + corresponding_tls_version/1, corresponding_dtls_version/1]). -spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. suites(Minor) -> - tls_v1:suites(corresponding_minor_tls_version(Minor)). + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + tls_v1:suites(corresponding_minor_tls_version(Minor))). +all_suites(Version) -> + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + ssl_cipher:all_suites(corresponding_tls_version(Version))). mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, @@ -50,3 +59,5 @@ corresponding_minor_dtls_version(2) -> 255; corresponding_minor_dtls_version(3) -> 253. +is_acceptable_cipher(Suite) -> + not ssl_cipher:is_stream_ciphersuite(Suite). diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 9c5d795848..064dcd6892 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -10,12 +10,14 @@ tls_v1, ssl_v3, ssl_v2, + tls_connection_sup, %% DTLS dtls_connection, dtls_handshake, dtls_record, dtls_socket, dtls_v1, + dtls_connection_sup, dtls_udp_listener, dtls_udp_sup, %% API @@ -31,16 +33,19 @@ ssl_cipher, ssl_srp_primes, ssl_alert, - ssl_listen_tracker_sup, + ssl_listen_tracker_sup, %% may be used by DTLS over SCTP %% Erlang Distribution over SSL/TLS inet_tls_dist, inet6_tls_dist, ssl_tls_dist_proxy, ssl_dist_sup, - %% SSL/TLS session handling + ssl_dist_connection_sup, + ssl_dist_admin_sup, + %% SSL/TLS session and cert handling ssl_session, ssl_session_cache, ssl_manager, + ssl_pem_cache, ssl_pkix_db, ssl_certificate, %% CRL handling @@ -51,14 +56,14 @@ %% App structure ssl_app, ssl_sup, - tls_connection_sup, - dtls_connection_sup + ssl_admin_sup, + ssl_connection_sup ]}, {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-3.1","public_key-1.2","kernel-3.0", + {runtime_dependencies, ["stdlib-3.2","public_key-1.2","kernel-3.0", "erts-7.0","crypto-3.3", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 32252386b4..bfdd0c205b 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,11 +1,19 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]}, - {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]} + {<<"8\\..*">>, [{restart_application, ssl}]}, + {<<"7\\..*">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]}, - {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]} - ] + {<<"8\\..*">>, [{restart_application, ssl}]}, + {<<"7\\..*">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} + ] }. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c72ee44a95..ed04c7e67b 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -187,16 +187,24 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_accept(Socket, Timeout); -ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try - {ok, EmOpts, InheritedSslOpts} = tls_socket:get_all_opts(Tracker), - SslOpts = handle_options(SslOpts0, InheritedSslOpts), + {ok, EmOpts, _} = tls_socket:get_all_opts(Tracker), ssl_connection:handshake(Socket, {SslOpts, tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; +ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> + try + {ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid), + ssl_connection:handshake(Socket, {SslOpts, + tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout) + catch + Error = {error, _Reason} -> Error + end; ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = @@ -215,7 +223,6 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), catch Error = {error, _Reason} -> Error end. - %%-------------------------------------------------------------------- -spec close(#sslsocket{}) -> term(). %% @@ -223,6 +230,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), %%-------------------------------------------------------------------- close(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT}); +close(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) -> + dtls_udp_listener:close(Pid); close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) -> Transport:close(ListenSocket). @@ -251,6 +260,8 @@ send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); send(#sslsocket{pid = {_, #config{transport_info={gen_udp, _, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour +send(#sslsocket{pid = {udp,_}}, _) -> + {error,enotconn}; send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) -> Transport:send(ListenSocket, Data). %% {error,enotconn} @@ -265,6 +276,8 @@ recv(Socket, Length) -> recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); +recv(#sslsocket{pid = {udp,_}}, _, _) -> + {error,enotconn}; recv(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> Transport:recv(Listen, 0). %% {error,enotconn} @@ -277,10 +290,14 @@ recv(#sslsocket{pid = {Listen, %%-------------------------------------------------------------------- controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> ssl_connection:new_user(Pid, NewOwner); +controlling_process(#sslsocket{pid = {udp, _}}, + NewOwner) when is_pid(NewOwner) -> + ok; %% Meaningless but let it be allowed to conform with TLS controlling_process(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, NewOwner) when is_port(Listen), is_pid(NewOwner) -> + %% Meaningless but let it be allowed to conform with normal sockets Transport:controlling_process(Listen, NewOwner). @@ -297,7 +314,9 @@ connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> Error end; connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - {error, enotconn}. + {error, enotconn}; +connection_information(#sslsocket{pid = {udp,_}}) -> + {error,enotconn}. %%-------------------------------------------------------------------- -spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. @@ -333,10 +352,18 @@ connection_info(#sslsocket{} = SSLSocket) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)-> + dtls_socket:peername(Transport, Socket); peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> tls_socket:peername(Transport, Socket); +peername(#sslsocket{pid = {udp = Transport, #config{udp_handler = {_Pid, _}}}}) -> + dtls_socket:peername(Transport, undefined); +peername(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) -> + dtls_socket:peername(Transport, Socket); peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> - tls_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} + tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn} +peername(#sslsocket{pid = {udp,_}}) -> + {error,enotconn}. %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. @@ -350,6 +377,8 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> Result -> Result end; +peercert(#sslsocket{pid = {udp, _}}) -> + {error, enotconn}; peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. @@ -506,6 +535,8 @@ getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_ shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}, How) when is_port(Listen) -> Transport:shutdown(Listen, How); +shutdown(#sslsocket{pid = {udp,_}},_) -> + {error, enotconn}; shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). @@ -518,7 +549,7 @@ sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _ tls_socket:sockname(Transport, Listen); sockname(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) -> dtls_udp_listener:sockname(Pid); -sockname(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) -> dtls_socket:sockname(Transport, Socket); sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> tls_socket:sockname(Transport, Socket). @@ -531,6 +562,8 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) %%-------------------------------------------------------------------- session_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:session_info(Pid); +session_info(#sslsocket{pid = {udp,_}}) -> + {error, enotconn}; session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. @@ -555,6 +588,8 @@ versions() -> %%-------------------------------------------------------------------- renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:renegotiation(Pid); +renegotiate(#sslsocket{pid = {udp,_}}) -> + {error, enotconn}; renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. @@ -568,6 +603,8 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> prf(#sslsocket{pid = Pid}, Secret, Label, Seed, WantedLength) when is_pid(Pid) -> ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength); +prf(#sslsocket{pid = {udp,_}}, _,_,_,_) -> + {error, enotconn}; prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> {error, enotconn}. @@ -577,7 +614,7 @@ prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> %% Description: Clear the PEM cache %%-------------------------------------------------------------------- clear_pem_cache() -> - ssl_manager:clear_pem_cache(). + ssl_pem_cache:clear(). %%--------------------------------------------------------------- -spec format_error({error, term()}) -> list(). @@ -696,7 +733,7 @@ handle_options(Opts0, Role) -> [RecordCb:protocol_version(Vsn) || Vsn <- Vsns] end, - Protocol = proplists:get_value(protocol, Opts, tls), + Protocol = handle_option(protocol, Opts, tls), SSLOptions = #ssl_options{ versions = Versions, @@ -755,7 +792,7 @@ handle_options(Opts0, Role) -> honor_ecc_order = handle_option(honor_ecc_order, Opts, default_option_role(server, false, Role), server, Role), - protocol = Protocol, + protocol = Protocol, padding_check = proplists:get_value(padding_check, Opts, true), beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one), fallback = handle_option(fallback, Opts, @@ -765,7 +802,8 @@ handle_options(Opts0, Role) -> client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), - v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false) + v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false), + max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE) }, CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), @@ -780,7 +818,8 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible], + fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible, + max_handshake_size], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -1028,6 +1067,12 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse Value; validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> Value; +validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 -> + Value; +validate_option(protocol, Value = tls) -> + Value; +validate_option(protocol, Value = dtls) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). @@ -1065,17 +1110,37 @@ validate_binary_list(Opt, List) -> (Bin) -> throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) end, List). - validate_versions([], Versions) -> Versions; validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; Version == 'tlsv1.1'; Version == tlsv1; Version == sslv3 -> - validate_versions(Rest, Versions); + tls_validate_versions(Rest, Versions); +validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; + Version == 'dtlsv2'-> + dtls_validate_versions(Rest, Versions); validate_versions([Ver| _], Versions) -> throw({error, {options, {Ver, {versions, Versions}}}}). +tls_validate_versions([], Versions) -> + Versions; +tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + tls_validate_versions(Rest, Versions); +tls_validate_versions([Ver| _], Versions) -> + throw({error, {options, {Ver, {versions, Versions}}}}). + +dtls_validate_versions([], Versions) -> + Versions; +dtls_validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; + Version == 'dtlsv2'-> + dtls_validate_versions(Rest, Versions); +dtls_validate_versions([Ver| _], Versions) -> + throw({error, {options, {Ver, {versions, Versions}}}}). + validate_inet_option(mode, Value) when Value =/= list, Value =/= binary -> throw({error, {options, {mode,Value}}}); @@ -1147,18 +1212,18 @@ handle_cipher_option(Value, Version) when is_list(Value) -> binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(Version)); + ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - All = ssl_cipher:all_suites(Version), + All = ssl_cipher:all_suites(tls_version(Version)), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(Version)); + ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); Ciphers -> Ciphers end; @@ -1171,7 +1236,8 @@ binary_cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). -handle_eccs_option(Value, {_Major, Minor}) when is_list(Value) -> +handle_eccs_option(Value, Version) when is_list(Value) -> + {_Major, Minor} = tls_version(Version), try tls_v1:ecc_curves(Minor, Value) of Curves -> #elliptic_curves{elliptic_curve_list = Curves} catch @@ -1344,7 +1410,10 @@ new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordC handle_hashsigns_option(Value, tls_version(RecordCB:highest_protocol_version()))}, RecordCB); - +new_ssl_options([{protocol, dtls = Value} | Rest], #ssl_options{} = Opts, dtls_record = RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB); +new_ssl_options([{protocol, tls = Value} | Rest], #ssl_options{} = Opts, tls_record = RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB); new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> throw({error, {options, {Key, Value}}}). diff --git a/lib/ssl/src/ssl_admin_sup.erl b/lib/ssl/src/ssl_admin_sup.erl new file mode 100644 index 0000000000..9c96435753 --- /dev/null +++ b/lib/ssl/src/ssl_admin_sup.erl @@ -0,0 +1,95 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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(ssl_admin_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0, manager_opts/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + PEMCache = pem_cache_child_spec(), + SessionCertManager = session_and_cert_manager_child_spec(), + {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +pem_cache_child_spec() -> + Name = ssl_pem_cache, + StartFunc = {ssl_pem_cache, start_link, [[]]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_pem_cache], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_and_cert_manager_child_spec() -> + Opts = manager_opts(), + Name = ssl_manager, + StartFunc = {ssl_manager, start_link, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_cb_init_args() -> + case application:get_env(ssl, session_cb_init_args) of + {ok, Args} when is_list(Args) -> + Args; + _ -> + [] + end. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index f359655d85..8aa2aa4081 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -125,21 +125,21 @@ file_to_crls(File, DbHandle) -> %% Description: Validates ssl/tls specific extensions %%-------------------------------------------------------------------- validate(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage', - extnValue = KeyUse}}, {Role, _,_, _, _}) -> + extnValue = KeyUse}}, UserState = {Role, _,_, _, _}) -> case is_valid_extkey_usage(KeyUse, Role) of true -> - {valid, Role}; + {valid, UserState}; false -> {fail, {bad_cert, invalid_ext_key_usage}} end; -validate(_, {extension, _}, Role) -> - {unknown, Role}; +validate(_, {extension, _}, UserState) -> + {unknown, UserState}; validate(_, {bad_cert, _} = Reason, _) -> {fail, Reason}; -validate(_, valid, Role) -> - {valid, Role}; -validate(_, valid_peer, Role) -> - {valid, Role}. +validate(_, valid, UserState) -> + {valid, UserState}; +validate(_, valid_peer, UserState) -> + {valid, UserState}. %%-------------------------------------------------------------------- -spec is_valid_key_usage(list(), term()) -> boolean(). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 32fec03b8e..8e6860e9dc 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -40,7 +40,8 @@ ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, - random_bytes/1, calc_aad/3, calc_mac_hash/4]). + random_bytes/1, calc_aad/3, calc_mac_hash/4, + is_stream_ciphersuite/1]). -export_type([cipher_suite/0, erl_cipher_suite/0, openssl_cipher_suite/0, @@ -310,18 +311,21 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, %%-------------------------------------------------------------------- suites({3, 0}) -> ssl_v3:suites(); -suites({3, N}) -> - tls_v1:suites(N); -suites(Version) -> - suites(dtls_v1:corresponding_tls_version(Version)). +suites({3, Minor}) -> + tls_v1:suites(Minor); +suites({_, Minor}) -> + dtls_v1:suites(Minor). -all_suites(Version) -> +all_suites({3, _} = Version) -> suites(Version) ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) - ++ des_suites(Version). + ++ des_suites(Version); +all_suites(Version) -> + dtls_v1:all_suites(Version). + %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -1541,6 +1545,10 @@ calc_mac_hash(Type, Version, MacSecret, SeqNo, Type, Length, PlainFragment). +is_stream_ciphersuite({_, rc4_128, _, _}) -> + true; +is_stream_ciphersuite(_) -> + false. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index 0652d029c3..09d4c3e678 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -32,18 +32,20 @@ init(SslOpts, Role) -> init_manager_name(SslOpts#ssl_options.erl_dist), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbHandle, OwnCert} + {ok, #{pem_cache := PemCache} = Config} = init_certificates(SslOpts, Role), PrivateKey = - init_private_key(PemCacheHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, + init_private_key(PemCache, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, SslOpts#ssl_options.password, Role), - DHParams = init_diffie_hellman(PemCacheHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), - {ok, CertDbRef, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, PrivateKey, DHParams}. + DHParams = init_diffie_hellman(PemCache, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), + {ok, Config#{private_key => PrivateKey, dh_params => DHParams}}. init_manager_name(false) -> - put(ssl_manager, ssl_manager:manager_name(normal)); + put(ssl_manager, ssl_manager:name(normal)), + put(ssl_pem_cache, ssl_pem_cache:name(normal)); init_manager_name(true) -> - put(ssl_manager, ssl_manager:manager_name(dist)). + put(ssl_manager, ssl_manager:name(dist)), + put(ssl_pem_cache, ssl_pem_cache:name(dist)). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, @@ -51,7 +53,7 @@ init_certificates(#ssl_options{cacerts = CaCerts, cert = Cert, crl_cache = CRLCache }, Role) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo} = + {ok, Config} = try Certs = case CaCerts of undefined -> @@ -59,41 +61,37 @@ init_certificates(#ssl_options{cacerts = CaCerts, _ -> {der, CaCerts} end, - {ok, _, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role, CRLCache) + {ok,_} = ssl_manager:connection_init(Certs, Role, CRLCache) catch _:Reason -> file_error(CACertFile, {cacertfile, Reason}) end, - init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, - CacheHandle, CRLDbInfo, CertFile, Role). + init_certificates(Cert, Config, CertFile, Role). -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, - CRLDbInfo, <<>>, _) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined}; +init_certificates(undefined, Config, <<>>, _) -> + {ok, Config#{own_certificate => undefined}}; -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, - CacheHandle, CRLDbInfo, CertFile, client) -> +init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, client) -> try %% Ignoring potential proxy-certificates see: %% http://dev.globus.org/wiki/Security/ProxyFileFormat - [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, OwnCert} + [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache), + {ok, Config#{own_certificate => OwnCert}} catch _Error:_Reason -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined} - end; + {ok, Config#{own_certificate => undefined}} + end; -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, - PemCacheHandle, CacheRef, CRLDbInfo, CertFile, server) -> +init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server) -> try - [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, OwnCert} + [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache), + {ok, Config#{own_certificate => OwnCert}} catch _:Reason -> file_error(CertFile, {certfile, Reason}) end; -init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, _, _) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, Cert}. - +init_certificates(Cert, Config, _, _) -> + {ok, Config#{own_certificate => Cert}}. + init_private_key(_, undefined, <<>>, _Password, _Client) -> undefined; init_private_key(DbHandle, undefined, KeyFile, Password, _) -> @@ -135,6 +133,8 @@ file_error(File, Throw) -> case Throw of {Opt,{badmatch, {error, {badmatch, Error}}}} -> throw({options, {Opt, binary_to_list(File), Error}}); + {Opt, {badmatch, Error}} -> + throw({options, {Opt, binary_to_list(File), Error}}); _ -> throw(Throw) end. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6e7c8c5ddd..5244db31af 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -148,19 +148,19 @@ socket_control(Connection, Socket, Pid, Transport) -> %%-------------------------------------------------------------------- socket_control(Connection, Socket, Pid, Transport, udp_listner) -> %% dtls listner process must have the socket control - {ok, dtls_socket:socket(Pid, Transport, Socket, Connection)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)}; socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end; socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -323,8 +323,14 @@ handle_session(#server_hello{cipher_suite = CipherSuite, -spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}. %%-------------------------------------------------------------------- ssl_config(Opts, Role, State) -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, - OwnCert, Key, DHParams} = + {ok, #{cert_db_ref := Ref, + cert_db_handle := CertDbHandle, + fileref_db_handle := FileRefHandle, + session_cache := CacheHandle, + crl_db_info := CRLDbHandle, + private_key := Key, + dh_params := DHParams, + own_certificate := OwnCert}} = ssl_config:init(Opts, Role), Handshake = ssl_handshake:init_handshake_history(), TimeStamp = erlang:monotonic_time(), @@ -335,7 +341,7 @@ ssl_config(Opts, Role, State) -> file_ref_db = FileRefHandle, cert_db_ref = Ref, cert_db = CertDbHandle, - crl_db = CRLDbInfo, + crl_db = CRLDbHandle, session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams, @@ -357,11 +363,13 @@ init({call, From}, {start, Timeout}, State0, Connection) -> timer = Timer}), Connection:next_event(hello, Record, State); init({call, From}, {start, {Opts, EmOpts}, Timeout}, - #state{role = Role} = State0, Connection) -> + #state{role = Role, ssl_options = OrigSSLOptions, + socket_options = SockOpts} = State0, Connection) -> try - State = ssl_config(Opts, Role, State0), + SslOpts = ssl:handle_options(Opts, OrigSSLOptions), + State = ssl_config(SslOpts, Role, State0), init({call, From}, {start, Timeout}, - State#state{ssl_options = Opts, socket_options = EmOpts}, Connection) + State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection) catch throw:Error -> {stop_and_reply, normal, {reply, From, {error, Error}}} end; @@ -426,11 +434,11 @@ abbreviated(internal, #finished{verify_data = Data} = Finished, verified -> ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), - State1 = + {State1, Actions} = finalize_handshake(State0#state{connection_states = ConnectionStates1}, abbreviated, Connection), {Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection), - Connection:next_event(connection, Record, State); + Connection:next_event(connection, Record, State, Actions); #alert{} = Alert -> handle_own_alert(Alert, Version, abbreviated, State0) end; @@ -850,6 +858,7 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, StateName, State); handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, _) -> + ct:pal("Unexpected msg ~p", [Msg]), Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), handle_own_alert(Alert, Version, {StateName, Msg}, State). @@ -864,11 +873,11 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i %% When downgrading an TLS connection to a transport connection %% we must recive the close alert from the peer before releasing the %% transport socket. - {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; + {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]}; handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option - Result = Connection:terminate(Close, StateName, State), + %% inet-option works properly + Result = Connection:terminate(Close, StateName, State#state{terminated = true}), {stop_and_reply, {shutdown, normal}, {reply, From, Result}, State}; handle_call({shutdown, How0}, From, _, @@ -1010,7 +1019,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called - %% when ssl:close/1 returns. + %% when ssl:close/1 returns unless it is a downgrade where + %% we want to guarantee that close alert is recived before + %% returning. In both cases terminate has been run manually + %% before run by gen_statem which will end up here ok; terminate({shutdown, transport_closed} = Reason, @@ -1227,13 +1239,13 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite, negotiated_version = Version} = State0, Connection) -> try server_certify_and_key_exchange(State0, Connection) of #state{} = State1 -> - State2 = server_hello_done(State1, Connection), + {State2, Actions} = server_hello_done(State1, Connection), Session = Session0#session{session_id = SessionId, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State2#state{session = Session}), - Connection:next_event(certify, Record, State) + Connection:next_event(certify, Record, State, Actions) catch #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0) @@ -1248,10 +1260,10 @@ resumed_server_hello(#state{session = Session, {_, ConnectionStates1} -> State1 = State0#state{connection_states = ConnectionStates1, session = Session}, - State2 = + {State2, Actions} = finalize_handshake(State1, abbreviated, Connection), {Record, State} = Connection:next_record(State2), - Connection:next_event(abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State, Actions); #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0) end. @@ -1334,12 +1346,12 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = State0, Connection) -> try do_client_certify_and_key_exchange(State0, Connection) of State1 = #state{} -> - State2 = finalize_handshake(State1, certify, Connection), + {State2, Actions} = finalize_handshake(State1, certify, Connection), State3 = State2#state{ %% Reinitialize client_certificate_requested = false}, {Record, State} = Connection:next_record(State3), - Connection:next_event(cipher, Record, State) + Connection:next_event(cipher, Record, State, Actions) catch throw:#alert{} = Alert -> handle_own_alert(Alert, Version, certify, State0) @@ -1861,11 +1873,11 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0 Connection) -> ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), - State1 = + {State1, Actions} = finalize_handshake(State0#state{connection_states = ConnectionStates1, session = Session}, cipher, Connection), {Record, State} = prepare_connection(State1, Connection), - Connection:next_event(connection, Record, State). + Connection:next_event(connection, Record, State, Actions). is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; @@ -2296,7 +2308,7 @@ format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data, Tracker, Connection) -> - {ssl, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl, Connection:socket(self(), Transport, Socket, Connection, Tracker), do_format_reply(Mode, Packet, Header, Data)}. deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) -> @@ -2305,7 +2317,7 @@ deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Da format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _, _) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker, Connection) -> - {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -2360,11 +2372,11 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, tls_socket:socket(self(), + {ssl_closed, Connection:socket(self(), Transport, Socket, Connection, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, tls_socket:socket(self(), + {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker), ReasonCode}) end. @@ -2425,16 +2437,23 @@ handle_sni_extension(#sni{hostname = Hostname}, State0) -> undefined -> State0; _ -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, Key, DHParams} = - ssl_config:init(NewOptions, State0#state.role), - State0#state{ - session = State0#state.session#session{own_certificate = OwnCert}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbHandle, - session_cache = CacheHandle, - private_key = Key, + {ok, #{cert_db_ref := Ref, + cert_db_handle := CertDbHandle, + fileref_db_handle := FileRefHandle, + session_cache := CacheHandle, + crl_db_info := CRLDbHandle, + private_key := Key, + dh_params := DHParams, + own_certificate := OwnCert}} = + ssl_config:init(NewOptions, State0#state.role), + State0#state{ + session = State0#state.session#session{own_certificate = OwnCert}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbHandle, + session_cache = CacheHandle, + private_key = Key, diffie_hellman_params = DHParams, ssl_options = NewOptions, sni_hostname = Hostname @@ -2456,3 +2475,8 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> _ -> ssl:handle_options(SSLOption, OrigSSLOptions) end. + +new_emulated([], EmOpts) -> + EmOpts; +new_emulated(NewEmOpts, _) -> + NewEmOpts. diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl new file mode 100644 index 0000000000..1a1f43e683 --- /dev/null +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -0,0 +1,101 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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(ssl_connection_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + + TLSConnetionManager = tls_connection_manager_child_spec(), + %% Handles emulated options so that they inherited by the accept + %% socket, even when setopts is performed on the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + + DTLSConnetionManager = dtls_connection_manager_child_spec(), + DTLSUdpListeners = dtls_udp_listeners_spec(), + + {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager, + ListenOptionsTracker, + DTLSConnetionManager, + DTLSUdpListeners + ]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +tls_connection_manager_child_spec() -> + Name = tls_connection, + StartFunc = {tls_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +dtls_connection_manager_child_spec() -> + Name = dtls_connection, + StartFunc = {dtls_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [dtls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = tls_socket, + StartFunc = {ssl_listen_tracker_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +dtls_udp_listeners_spec() -> + Name = dtls_udp_listener, + StartFunc = {dtls_udp_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl index fc60bdba67..33375b5e09 100644 --- a/lib/ssl/src/ssl_crl.erl +++ b/lib/ssl/src/ssl_crl.erl @@ -29,7 +29,7 @@ -export([trusted_cert_and_path/3]). -trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) -> +trusted_cert_and_path(CRL, {SerialNumber, Issuer},{_, {Db, DbRef}} = DbHandle) -> case ssl_pkix_db:lookup_trusted_cert(Db, DbRef, SerialNumber, Issuer) of undefined -> trusted_cert_and_path(CRL, issuer_not_found, DbHandle); @@ -37,17 +37,34 @@ trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) -> {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), {ok, Root, lists:reverse(Chain)} end; - -trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbHandle) -> - case find_issuer(CRL, DbHandle) of +trusted_cert_and_path(CRL, issuer_not_found, {CertPath, {Db, DbRef}}) -> + case find_issuer(CRL, {certpath, + [{Der, public_key:pkix_decode_cert(Der,otp)} || Der <- CertPath]}) of {ok, OtpCert} -> {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), {ok, Root, lists:reverse(Chain)}; {error, issuer_not_found} -> - {ok, unknown_crl_ca, []} - end. + trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef}) + end; +trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbInfo) -> + case find_issuer(CRL, DbInfo) of + {ok, OtpCert} -> + {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), + {ok, Root, lists:reverse(Chain)}; + {error, issuer_not_found} -> + {error, unknown_ca} + end. -find_issuer(CRL, {Db,DbRef}) -> +find_issuer(CRL, {certpath = Db, DbRef}) -> + Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)), + IsIssuerFun = + fun({_Der,ErlCertCandidate}, Acc) -> + verify_crl_issuer(CRL, ErlCertCandidate, Issuer, Acc); + (_, Acc) -> + Acc + end, + find_issuer(IsIssuerFun, Db, DbRef); +find_issuer(CRL, {Db, DbRef}) -> Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)), IsIssuerFun = fun({_Key, {_Der,ErlCertCandidate}}, Acc) -> @@ -55,26 +72,33 @@ find_issuer(CRL, {Db,DbRef}) -> (_, Acc) -> Acc end, - if is_reference(DbRef) -> % actual DB exists - try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of - issuer_not_found -> - {error, issuer_not_found} - catch - {ok, _} = Result -> - Result - end; - is_tuple(DbRef), element(1,DbRef) =:= extracted -> % cache bypass byproduct - {extracted, CertsData} = DbRef, - Certs = [Entry || {decoded, Entry} <- CertsData], - try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of - issuer_not_found -> - {error, issuer_not_found} - catch - {ok, _} = Result -> - Result - end - end. + find_issuer(IsIssuerFun, Db, DbRef). +find_issuer(IsIssuerFun, certpath, Certs) -> + try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end; +find_issuer(IsIssuerFun, extracted, CertsData) -> + Certs = [Entry || {decoded, Entry} <- CertsData], + try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end; +find_issuer(IsIssuerFun, Db, _) -> + try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end. verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) -> TBSCert = ErlCertCandidate#'OTPCertificate'.tbsCertificate, diff --git a/lib/ssl/src/ssl_dist_admin_sup.erl b/lib/ssl/src/ssl_dist_admin_sup.erl new file mode 100644 index 0000000000..f60806c4cb --- /dev/null +++ b/lib/ssl/src/ssl_dist_admin_sup.erl @@ -0,0 +1,74 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-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(ssl_dist_admin_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + PEMCache = pem_cache_child_spec(), + SessionCertManager = session_and_cert_manager_child_spec(), + {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +pem_cache_child_spec() -> + Name = ssl_pem_cache_dist, + StartFunc = {ssl_pem_cache, start_link_dist, [[]]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_pem_cache], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_and_cert_manager_child_spec() -> + Opts = ssl_admin_sup:manager_opts(), + Name = ssl_dist_manager, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_dist_connection_sup.erl b/lib/ssl/src/ssl_dist_connection_sup.erl new file mode 100644 index 0000000000..e5842c866e --- /dev/null +++ b/lib/ssl/src/ssl_dist_connection_sup.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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(ssl_dist_connection_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + + TLSConnetionManager = tls_connection_manager_child_spec(), + %% Handles emulated options so that they inherited by the accept + %% socket, even when setopts is performed on the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + + {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager, + ListenOptionsTracker + ]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +tls_connection_manager_child_spec() -> + Name = dist_tls_connection, + StartFunc = {tls_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = dist_tls_socket, + StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index d47cd76bf5..690b896919 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -44,34 +44,29 @@ start_link() -> %%%========================================================================= init([]) -> - SessionCertManager = session_and_cert_manager_child_spec(), - ConnetionManager = connection_manager_child_spec(), - ListenOptionsTracker = listen_options_tracker_child_spec(), + AdminSup = ssl_admin_child_spec(), + ConnectionSup = ssl_connection_sup(), ProxyServer = proxy_server_child_spec(), - - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, - ListenOptionsTracker, - ProxyServer]}}. + {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -session_and_cert_manager_child_spec() -> - Opts = ssl_sup:manager_opts(), - Name = ssl_manager_dist, - StartFunc = {ssl_manager, start_link_dist, [Opts]}, +ssl_admin_child_spec() -> + Name = ssl_dist_admin_sup, + StartFunc = {ssl_dist_admin_sup, start_link , []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_manager], - Type = worker, + Modules = [ssl_admin_sup], + Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -connection_manager_child_spec() -> - Name = ssl_connection_dist, - StartFunc = {tls_connection_sup, start_link_dist, []}, - Restart = permanent, - Shutdown = infinity, - Modules = [tls_connection_sup], +ssl_connection_sup() -> + Name = ssl_dist_connection_sup, + StartFunc = {ssl_dist_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -83,12 +78,3 @@ proxy_server_child_spec() -> Modules = [ssl_tls_dist_proxy], Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -listen_options_tracker_child_spec() -> - Name = tls_socket_dist, - StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_socket], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 4acc745c5f..cb61c82334 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -397,14 +397,13 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature, %%-------------------------------------------------------------------- certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, MaxPathLen, _Verify, ValidationFunAndState0, PartialChain, CRLCheck, CRLDbHandle, Role) -> - [PeerCert | _] = ASN1Certs, - - ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role, - CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle), - + [PeerCert | _] = ASN1Certs, try {TrustedCert, CertPath} = ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, PartialChain), + ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role, + CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath), case public_key:pkix_path_validation(TrustedCert, CertPath, [{max_path_length, MaxPathLen}, @@ -1541,7 +1540,8 @@ sni1(Hostname) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) -> +validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath) -> {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> case ssl_certificate:validate(OtpCert, Extension, @@ -1550,22 +1550,25 @@ validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLC {valid, {NewSslState, UserState}}; {fail, Reason} -> apply_user_fun(Fun, OtpCert, Reason, UserState, - SslState); + SslState, CertPath); {unknown, _} -> apply_user_fun(Fun, OtpCert, - Extension, UserState, SslState) + Extension, UserState, SslState, CertPath) end; (OtpCert, VerifyResult, {SslState, UserState}) -> apply_user_fun(Fun, OtpCert, VerifyResult, UserState, - SslState) + SslState, CertPath) end, {{Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}, UserState0}}; -validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) -> +validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath) -> {fun(OtpCert, {extension, _} = Extension, SslState) -> ssl_certificate:validate(OtpCert, Extension, SslState); - (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or (VerifyResult == valid_peer) -> - case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of + (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or + (VerifyResult == valid_peer) -> + case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, + CRLDbHandle, VerifyResult, CertPath) of valid -> {VerifyResult, SslState}; Reason -> @@ -1578,20 +1581,21 @@ validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRL end, {Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}}. apply_user_fun(Fun, OtpCert, VerifyResult, UserState0, - {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState) when + {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState, CertPath) when (VerifyResult == valid) or (VerifyResult == valid_peer) -> case Fun(OtpCert, VerifyResult, UserState0) of {Valid, UserState} when (Valid == valid) or (Valid == valid_peer) -> - case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of + case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, + CRLDbHandle, VerifyResult, CertPath) of valid -> {Valid, {SslState, UserState}}; Result -> - apply_user_fun(Fun, OtpCert, Result, UserState, SslState) + apply_user_fun(Fun, OtpCert, Result, UserState, SslState, CertPath) end; {fail, _} = Fail -> Fail end; -apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> +apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState, _CertPath) -> case Fun(OtpCert, ExtensionOrError, UserState0) of {Valid, UserState} when (Valid == valid) or (Valid == valid_peer)-> {Valid, {SslState, UserState}}; @@ -2187,13 +2191,14 @@ handle_psk_identity(_PSKIdentity, LookupFun) handle_psk_identity(PSKIdentity, {Fun, UserState}) -> Fun(psk, PSKIdentity, UserState). -crl_check(_, false, _,_,_, _) -> +crl_check(_, false, _,_,_, _, _) -> valid; -crl_check(_, peer, _, _,_, valid) -> %% Do not check CAs with this option. +crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option. valid; -crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) -> +crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) -> Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) -> - ssl_crl:trusted_cert_and_path(CRL, Issuer, DBInfo) + ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath, + DBInfo}) end, {CertDbHandle, CertDbRef}}}, {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end} ], @@ -2229,7 +2234,8 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) -> no_dps; DistPoints -> Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer, - distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle) + CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle), + dps_and_crls(DistPoints, CRLs, []) end; dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> @@ -2242,7 +2248,13 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> end, GenNames), [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]. -distpoints_lookup([], _, _, _) -> +dps_and_crls([], _, Acc) -> + Acc; +dps_and_crls([DP | Rest], CRLs, Acc) -> + DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs], + dps_and_crls(Rest, CRLs, DpCRL ++ Acc). + +distpoints_lookup([],_, _, _) -> []; distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) -> Result = @@ -2257,7 +2269,7 @@ distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) -> not_available -> distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle); CRLs -> - [{DistPoint, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs] + CRLs end. sign_algo(?rsaEncryption) -> diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index fde92035a2..324b7dbde3 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -80,6 +80,9 @@ -define(CLIENT_KEY_EXCHANGE, 16). -define(FINISHED, 20). +-define(MAX_UNIT24, 8388607). +-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)). + -record(random, { gmt_unix_time, % uint32 random_bytes % opaque random_bytes[28] diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 98b89bb811..c10ec3a2d6 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -76,7 +76,7 @@ -define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]). -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). --define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). +-define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]). -define('24H_in_msec', 86400000). -define('24H_in_sec', 86400). @@ -142,7 +142,8 @@ signature_algs, eccs, honor_ecc_order :: boolean(), - v2_hello_compatible :: boolean() + v2_hello_compatible :: boolean(), + max_handshake_size :: integer() }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 5bd9521de7..2b82f18bb5 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -32,10 +32,9 @@ new_session_id/1, clean_cert_db/2, register_session/2, register_session/3, invalidate_session/2, insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2, - invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]). + invalidate_session/3, name/1]). -% Spawn export --export([init_session_validator/1, init_pem_cache_validator/1]). +-export([init_session_validator/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -52,9 +51,7 @@ session_lifetime :: integer(), certificate_db :: db_handle(), session_validation_timer :: reference(), - last_delay_timer = {undefined, undefined},%% Keep for testing purposes - last_pem_check :: erlang:timestamp(), - clear_pem_cache :: integer(), + last_delay_timer = {undefined, undefined},%% Keep for testing purposes session_cache_client_max :: integer(), session_cache_server_max :: integer(), session_server_invalidator :: undefined | pid(), @@ -63,7 +60,6 @@ -define(GEN_UNIQUE_ID_MAX_TRIES, 10). -define(SESSION_VALIDATION_INTERVAL, 60000). --define(CLEAR_PEM_CACHE, 120000). -define(CLEAN_SESSION_DB, 60000). -define(CLEAN_CERT_DB, 500). -define(DEFAULT_MAX_SESSION_CACHE, 1000). @@ -74,14 +70,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec manager_name(normal | dist) -> atom(). +-spec name(normal | dist) -> atom(). %% %% Description: Returns the registered name of the ssl manager process %% in the operation modes 'normal' and 'dist'. %%-------------------------------------------------------------------- -manager_name(normal) -> +name(normal) -> ?MODULE; -manager_name(dist) -> +name(dist) -> list_to_atom(atom_to_list(?MODULE) ++ "dist"). %%-------------------------------------------------------------------- @@ -91,9 +87,10 @@ manager_name(dist) -> %% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - DistMangerName = manager_name(normal), - gen_server:start_link({local, DistMangerName}, - ?MODULE, [DistMangerName, Opts], []). + MangerName = name(normal), + CacheName = ssl_pem_cache:name(normal), + gen_server:start_link({local, MangerName}, + ?MODULE, [MangerName, CacheName, Opts], []). %%-------------------------------------------------------------------- -spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. @@ -102,38 +99,23 @@ start_link(Opts) -> %% be used by the erlang distribution. Note disables soft upgrade! %%-------------------------------------------------------------------- start_link_dist(Opts) -> - DistMangerName = manager_name(dist), + DistMangerName = name(dist), + DistCacheName = ssl_pem_cache:name(dist), gen_server:start_link({local, DistMangerName}, - ?MODULE, [DistMangerName, Opts], []). + ?MODULE, [DistMangerName, DistCacheName, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(binary()| {der, list()}, client | server, {Cb :: atom(), Handle:: term()}) -> - {ok, certdb_ref(), db_handle(), db_handle(), - db_handle(), db_handle(), CRLInfo::term()}. + {ok, map()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- connection_init({der, _} = Trustedcerts, Role, CRLCache) -> - case bypass_pem_cache() of - true -> - {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), - call({connection_init, Extracted, Role, CRLCache}); - false -> - call({connection_init, Trustedcerts, Role, CRLCache}) - end; - -connection_init(<<>> = Trustedcerts, Role, CRLCache) -> - call({connection_init, Trustedcerts, Role, CRLCache}); - + {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), + call({connection_init, Extracted, Role, CRLCache}); connection_init(Trustedcerts, Role, CRLCache) -> - case bypass_pem_cache() of - true -> - {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), - call({connection_init, Extracted, Role, CRLCache}); - false -> - call({connection_init, Trustedcerts, Role, CRLCache}) - end. + call({connection_init, Trustedcerts, Role, CRLCache}). %%-------------------------------------------------------------------- -spec cache_pem_file(binary(), term()) -> {ok, term()} | {error, reason()}. @@ -141,31 +123,14 @@ connection_init(Trustedcerts, Role, CRLCache) -> %% Description: Cache a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> - case bypass_pem_cache() of - true -> - ssl_pkix_db:decode_pem_file(File); - false -> - case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of - [{Content,_}] -> - {ok, Content}; - [Content] -> - {ok, Content}; - undefined -> - call({cache_pem, File}) - end + case ssl_pkix_db:lookup(File, DbHandle) of + [Content] -> + {ok, Content}; + undefined -> + ssl_pem_cache:insert(File) end. %%-------------------------------------------------------------------- --spec clear_pem_cache() -> ok. -%% -%% Description: Clear the PEM cache -%%-------------------------------------------------------------------- -clear_pem_cache() -> - %% Not supported for distribution at the moement, should it be? - put(ssl_manager, manager_name(normal)), - call(unconditionally_clear_pem_cache). - -%%-------------------------------------------------------------------- -spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. @@ -222,26 +187,22 @@ invalidate_session(Port, Session) -> load_mitigation(), cast({invalidate_session, Port, Session}). --spec invalidate_pem(File::binary()) -> ok. -invalidate_pem(File) -> - cast({invalidate_pem, File}). - insert_crls(Path, CRLs)-> insert_crls(Path, CRLs, normal). insert_crls(?NO_DIST_POINT_PATH = Path, CRLs, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), cast({insert_crls, Path, CRLs}); insert_crls(Path, CRLs, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), call({insert_crls, Path, CRLs}). delete_crls(Path)-> delete_crls(Path, normal). delete_crls(?NO_DIST_POINT_PATH = Path, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), cast({delete_crls, Path}); delete_crls(Path, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), call({delete_crls, Path}). %%==================================================================== @@ -255,13 +216,14 @@ delete_crls(Path, ManagerType)-> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Name, Opts]) -> - put(ssl_manager, Name), +init([ManagerName, PemCacheName, Opts]) -> + put(ssl_manager, ManagerName), + put(ssl_pem_cache, PemCacheName), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), - CertDb = ssl_pkix_db:create(), + CertDb = ssl_pkix_db:create(PemCacheName), ClientSessionCache = CacheCb:init([{role, client} | proplists:get_value(session_cb_init_args, Opts, [])]), @@ -270,16 +232,12 @@ init([Name, Opts]) -> proplists:get_value(session_cb_init_args, Opts, [])]), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), - Interval = pem_check_interval(), - erlang:send_after(Interval, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, session_cache_client = ClientSessionCache, session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, session_validation_timer = Timer, - last_pem_check = os:timestamp(), - clear_pem_cache = Interval, session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = @@ -302,18 +260,25 @@ init([Name, Opts]) -> handle_call({{connection_init, <<>>, Role, {CRLCb, UserCRLDb}}, _Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) -> Ref = make_ref(), - Result = {ok, Ref, CertDb, FileRefDb, PemChace, - session_cache(Role, State), {CRLCb, crl_db_info(Db, UserCRLDb)}}, - {reply, Result, State#state{certificate_db = Db}}; + {reply, {ok, #{cert_db_ref => Ref, + cert_db_handle => CertDb, + fileref_db_handle => FileRefDb, + pem_cache => PemChace, + session_cache => session_cache(Role, State), + crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State}; handle_call({{connection_init, Trustedcerts, Role, {CRLCb, UserCRLDb}}, Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) -> case add_trusted_certs(Pid, Trustedcerts, Db) of {ok, Ref} -> - {reply, {ok, Ref, CertDb, FileRefDb, PemChace, session_cache(Role, State), - {CRLCb, crl_db_info(Db, UserCRLDb)}}, State}; - {error, _} = Error -> - {reply, Error, State} + {reply, {ok, #{cert_db_ref => Ref, + cert_db_handle => CertDb, + fileref_db_handle => FileRefDb, + pem_cache => PemChace, + session_cache => session_cache(Role, State), + crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State}; + {error, _} = Error -> + {reply, Error, State} end; handle_call({{insert_crls, Path, CRLs}, _}, _From, @@ -330,21 +295,7 @@ handle_call({{new_session_id, Port}, _}, _, #state{session_cache_cb = CacheCb, session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), - {reply, Id, State}; - -handle_call({{cache_pem,File}, _Pid}, _, - #state{certificate_db = Db} = State) -> - try ssl_pkix_db:cache_pem_file(File, Db) of - Result -> - {reply, Result, State} - catch - _:Reason -> - {reply, {error, Reason}, State} - end; -handle_call({unconditionally_clear_pem_cache, _},_, - #state{certificate_db = [_,_,PemChace | _]} = State) -> - ssl_pkix_db:clear(PemChace), - {reply, ok, State}. + {reply, Id, State}. %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. @@ -382,11 +333,6 @@ handle_cast({insert_crls, Path, CRLs}, handle_cast({delete_crls, CRLsOrPath}, #state{certificate_db = Db} = State) -> ssl_pkix_db:remove_crls(Db, CRLsOrPath), - {noreply, State}; - -handle_cast({invalidate_pem, File}, - #state{certificate_db = [_, _, PemCache | _]} = State) -> - ssl_pkix_db:remove(File, PemCache), {noreply, State}. %%-------------------------------------------------------------------- @@ -418,22 +364,14 @@ handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = Cache CacheCb:delete(Cache, Key), {noreply, State}; -handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace | _], - clear_pem_cache = Interval, - last_pem_check = CheckPoint} = State) -> - NewCheckPoint = os:timestamp(), - start_pem_cache_validator(PemChace, CheckPoint), - erlang:send_after(Interval, self(), clear_pem_cache), - {noreply, State#state{last_pem_check = NewCheckPoint}}; - handle_info({clean_cert_db, Ref, File}, - #state{certificate_db = [CertDb,RefDb, PemCache | _]} = State) -> + #state{certificate_db = [CertDb, {RefDb, FileMapDb} | _]} = State) -> case ssl_pkix_db:lookup(Ref, RefDb) of undefined -> %% Alredy cleaned ok; _ -> - clean_cert_db(Ref, CertDb, RefDb, PemCache, File) + clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) end, {noreply, State}; @@ -523,14 +461,6 @@ delay_time() -> ?CLEAN_SESSION_DB end. -bypass_pem_cache() -> - case application:get_env(ssl, bypass_pem_cache) of - {ok, Bool} when is_boolean(Bool) -> - Bool; - _ -> - false - end. - max_session_cache_size(CacheType) -> case application:get_env(ssl, CacheType) of {ok, Size} when is_integer(Size) -> @@ -594,16 +524,11 @@ new_id(Port, Tries, Cache, CacheCb) -> new_id(Port, Tries - 1, Cache, CacheCb) end. -clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> +clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) -> case ssl_pkix_db:ref_count(Ref, RefDb, 0) of 0 -> - case ssl_pkix_db:lookup_cached_pem(PemCache, File) of - [{Content, Ref}] -> - ssl_pkix_db:insert(File, Content, PemCache); - _ -> - ok - end, ssl_pkix_db:remove(Ref, RefDb), + ssl_pkix_db:remove(File, FileMapDb), ssl_pkix_db:remove_trusted_certs(Ref, CertDb); _ -> ok @@ -687,42 +612,6 @@ exists_equivalent(#session{ exists_equivalent(Session, [ _ | Rest]) -> exists_equivalent(Session, Rest). -start_pem_cache_validator(PemCache, CheckPoint) -> - spawn_link(?MODULE, init_pem_cache_validator, - [[get(ssl_manager), PemCache, CheckPoint]]). - -init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) -> - put(ssl_manager, SslManagerName), - ssl_pkix_db:foldl(fun pem_cache_validate/2, - CheckPoint, PemCache). - -pem_cache_validate({File, _}, CheckPoint) -> - case file:read_file_info(File, []) of - {ok, #file_info{mtime = Time}} -> - case is_before_checkpoint(Time, CheckPoint) of - true -> - ok; - false -> - invalidate_pem(File) - end; - _ -> - invalidate_pem(File) - end, - CheckPoint. - -pem_check_interval() -> - case application:get_env(ssl, ssl_pem_cache_clean) of - {ok, Interval} when is_integer(Interval) -> - Interval; - _ -> - ?CLEAR_PEM_CACHE - end. - -is_before_checkpoint(Time, CheckPoint) -> - calendar:datetime_to_gregorian_seconds( - calendar:now_to_datetime(CheckPoint)) - - calendar:datetime_to_gregorian_seconds(Time) > 0. - add_trusted_certs(Pid, Trustedcerts, Db) -> try ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db) diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl new file mode 100644 index 0000000000..f63a301f69 --- /dev/null +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -0,0 +1,266 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 20016-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% +%% + +%%---------------------------------------------------------------------- +%% Purpose: Manages ssl sessions and trusted certifacates +%%---------------------------------------------------------------------- + +-module(ssl_pem_cache). +-behaviour(gen_server). + +%% Internal application API +-export([start_link/1, + start_link_dist/1, + name/1, + insert/1, + clear/0]). + +% Spawn export +-export([init_pem_cache_validator/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-include("ssl_handshake.hrl"). +-include("ssl_internal.hrl"). +-include_lib("kernel/include/file.hrl"). + +-record(state, { + pem_cache, + last_pem_check :: erlang:timestamp(), + clear :: integer() + }). + +-define(CLEAR_PEM_CACHE, 120000). +-define(DEFAULT_MAX_SESSION_CACHE, 1000). + +%%==================================================================== +%% API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec name(normal | dist) -> atom(). +%% +%% Description: Returns the registered name of the ssl cache process +%% in the operation modes 'normal' and 'dist'. +%%-------------------------------------------------------------------- +name(normal) -> + ?MODULE; +name(dist) -> + list_to_atom(atom_to_list(?MODULE) ++ "dist"). + +%%-------------------------------------------------------------------- +-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts the ssl pem cache handler +%%-------------------------------------------------------------------- +start_link(_) -> + CacheName = name(normal), + gen_server:start_link({local, CacheName}, + ?MODULE, [CacheName], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(_) -> + DistCacheName = name(dist), + gen_server:start_link({local, DistCacheName}, + ?MODULE, [DistCacheName], []). + + +%%-------------------------------------------------------------------- +-spec insert(binary()) -> {ok, term()} | {error, reason()}. +%% +%% Description: Cache a pem file and return its content. +%%-------------------------------------------------------------------- +insert(File) -> + {ok, PemBin} = file:read_file(File), + Content = public_key:pem_decode(PemBin), + case bypass_cache() of + true -> + {ok, Content}; + false -> + cast({cache_pem, File, Content}), + {ok, Content} + end. + +%%-------------------------------------------------------------------- +-spec clear() -> ok. +%% +%% Description: Clear the PEM cache +%%-------------------------------------------------------------------- +clear() -> + %% Not supported for distribution at the moement, should it be? + put(ssl_pem_cache, name(normal)), + call(unconditionally_clear_pem_cache). + +-spec invalidate_pem(File::binary()) -> ok. +invalidate_pem(File) -> + cast({invalidate_pem, File}). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec init(list()) -> {ok, #state{}}. +%% Possible return values not used now. +%% | {ok, #state{}, timeout()} | ignore | {stop, term()}. +%% +%% Description: Initiates the server +%%-------------------------------------------------------------------- +init([Name]) -> + put(ssl_pem_cache, Name), + process_flag(trap_exit, true), + PemCache = ssl_pkix_db:create_pem_cache(Name), + Interval = pem_check_interval(), + erlang:send_after(Interval, self(), clear_pem_cache), + {ok, #state{pem_cache = PemCache, + last_pem_check = os:timestamp(), + clear = Interval + }}. + +%%-------------------------------------------------------------------- +-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. +%% Possible return values not used now. +%% {reply, reply(), #state{}, timeout()} | +%% {noreply, #state{}} | +%% {noreply, #state{}, timeout()} | +%% {stop, reason(), reply(), #state{}} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call({unconditionally_clear_pem_cache, _},_, + #state{pem_cache = PemCache} = State) -> + ssl_pkix_db:clear(PemCache), + {reply, ok, State}. + +%%-------------------------------------------------------------------- +-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% | {noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast({cache_pem, File, Content}, #state{pem_cache = Db} = State) -> + ssl_pkix_db:insert(File, Content, Db), + {noreply, State}; + +handle_cast({invalidate_pem, File}, #state{pem_cache = Db} = State) -> + ssl_pkix_db:remove(File, Db), + {noreply, State}. + + +%%-------------------------------------------------------------------- +-spec handle_info(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% |{noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling all non call/cast messages +%%------------------------------------------------------------------- +handle_info(clear_pem_cache, #state{pem_cache = PemCache, + clear = Interval, + last_pem_check = CheckPoint} = State) -> + NewCheckPoint = os:timestamp(), + start_pem_cache_validator(PemCache, CheckPoint), + erlang:send_after(Interval, self(), clear_pem_cache), + {noreply, State#state{last_pem_check = NewCheckPoint}}; + +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +-spec terminate(reason(), #state{}) -> ok. +%% +%% Description: This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any necessary +%% cleaning up. When it returns, the gen_server terminates with Reason. +%% The return value is ignored. +%%-------------------------------------------------------------------- +terminate(_Reason, #state{}) -> + ok. + +%%-------------------------------------------------------------------- +-spec code_change(term(), #state{}, list()) -> {ok, #state{}}. +%% +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +call(Msg) -> + gen_server:call(get(ssl_pem_cache), {Msg, self()}, infinity). + +cast(Msg) -> + gen_server:cast(get(ssl_pem_cache), Msg). + +start_pem_cache_validator(PemCache, CheckPoint) -> + spawn_link(?MODULE, init_pem_cache_validator, + [[get(ssl_pem_cache), PemCache, CheckPoint]]). + +init_pem_cache_validator([CacheName, PemCache, CheckPoint]) -> + put(ssl_pem_cache, CacheName), + ssl_pkix_db:foldl(fun pem_cache_validate/2, + CheckPoint, PemCache). + +pem_cache_validate({File, _}, CheckPoint) -> + case file:read_file_info(File, []) of + {ok, #file_info{mtime = Time}} -> + case is_before_checkpoint(Time, CheckPoint) of + true -> + ok; + false -> + invalidate_pem(File) + end; + _ -> + invalidate_pem(File) + end, + CheckPoint. + +is_before_checkpoint(Time, CheckPoint) -> + calendar:datetime_to_gregorian_seconds( + calendar:now_to_datetime(CheckPoint)) - + calendar:datetime_to_gregorian_seconds(Time) > 0. + +pem_check_interval() -> + case application:get_env(ssl, ssl_pem_cache_clean) of + {ok, Interval} when is_integer(Interval) -> + Interval; + _ -> + ?CLEAR_PEM_CACHE + end. + +bypass_cache() -> + case application:get_env(ssl, bypass_pem_cache) of + {ok, Bool} when is_boolean(Bool) -> + Bool; + _ -> + false + end. diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index b4299969e4..cde05bb16f 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -28,11 +28,11 @@ -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). --export([create/0, add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3, +-export([create/1, create_pem_cache/1, + add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3, extract_trusted_certs/1, remove_trusted_certs/2, insert/3, remove/2, clear/1, db_size/1, ref_count/3, lookup_trusted_cert/4, foldl/3, select_cert_by_issuer/2, - lookup_cached_pem/2, cache_pem_file/2, cache_pem_file/3, decode_pem_file/1, lookup/2]). %%==================================================================== @@ -40,25 +40,31 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec create() -> [db_handle(),...]. +-spec create(atom()) -> [db_handle(),...]. %% %% Description: Creates a new certificate db. %% Note: lookup_trusted_cert/4 may be called from any process but only %% the process that called create may call the other functions. %%-------------------------------------------------------------------- -create() -> +create(PEMCacheName) -> [%% Let connection process delete trusted certs %% that can only belong to one connection. (Supplied directly %% on DER format to ssl:connect/listen.) ets:new(ssl_otp_cacertificate_db, [set, public]), %% Let connection processes call ref_count/3 directly - ets:new(ssl_otp_ca_file_ref, [set, public]), - ets:new(ssl_otp_pem_cache, [set, protected]), + {ets:new(ssl_otp_ca_file_ref, [set, public]), + ets:new(ssl_otp_ca_ref_file_mapping, [set, protected]) + }, + %% Lookups in named table owned by ssl_pem_cache process + PEMCacheName, %% Default cache {ets:new(ssl_otp_crl_cache, [set, protected]), ets:new(ssl_otp_crl_issuer_mapping, [bag, protected])} ]. +create_pem_cache(Name) -> + ets:new(Name, [named_table, set, protected]). + %%-------------------------------------------------------------------- -spec remove([db_handle()]) -> ok. %% @@ -70,6 +76,10 @@ remove(Dbs) -> true = ets:delete(Db1); (undefined) -> ok; + (ssl_pem_cache) -> + ok; + (ssl_pem_cache_dist) -> + ok; (Db) -> true = ets:delete(Db) end, Dbs). @@ -101,11 +111,6 @@ lookup_trusted_cert(_DbHandle, {extracted,Certs}, SerialNumber, Issuer) -> {ok, Cert} end. -lookup_cached_pem([_, _, PemChache | _], File) -> - lookup_cached_pem(PemChache, File); -lookup_cached_pem(PemChache, File) -> - lookup(File, PemChache). - %%-------------------------------------------------------------------- -spec add_trusted_certs(pid(), {erlang:timestamp(), string()} | {der, list()}, [db_handle()]) -> {ok, [db_handle()]}. @@ -122,17 +127,11 @@ add_trusted_certs(_Pid, {der, DerList}, [CertDb, _,_ | _]) -> add_certs_from_der(DerList, NewRef, CertDb), {ok, NewRef}; -add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache | _] = Db) -> - case lookup_cached_pem(Db, File) of - [{_Content, Ref}] -> +add_trusted_certs(_Pid, File, [ _, {RefDb, FileMapDb} | _] = Db) -> + case lookup(File, FileMapDb) of + [Ref] -> ref_count(Ref, RefDb, 1), {ok, Ref}; - [Content] -> - Ref = make_ref(), - update_counter(Ref, 1, RefDb), - insert(File, {Content, Ref}, PemChache), - add_certs_from_pem(Content, Ref, CertsDb), - {ok, Ref}; undefined -> new_trusted_cert_entry(File, Db) end. @@ -151,25 +150,6 @@ extract_trusted_certs(File) -> {error, {badmatch, Error}} end. -%%-------------------------------------------------------------------- -%% -%% Description: Cache file as binary in DB -%%-------------------------------------------------------------------- --spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}. -cache_pem_file(File, [_CertsDb, _RefDb, PemChache | _]) -> - {ok, PemBin} = file:read_file(File), - Content = public_key:pem_decode(PemBin), - insert(File, Content, PemChache), - {ok, Content}. - - --spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}. -cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache| _]) -> - {ok, PemBin} = file:read_file(File), - Content = public_key:pem_decode(PemBin), - insert(File, {Content, Ref}, PemChache), - {ok, Content}. - -spec decode_pem_file(binary()) -> {ok, term()}. decode_pem_file(File) -> case file:read_file(File) of @@ -246,6 +226,8 @@ select_cert_by_issuer(Cache, Issuer) -> %%-------------------------------------------------------------------- ref_count({extracted, _}, _Db, _N) -> not_cached; +ref_count(Key, {Db, _}, N) -> + ref_count(Key, Db, N); ref_count(Key, Db, N) -> ets:update_counter(Db,Key,N). @@ -278,9 +260,9 @@ insert(Key, Data, Db) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -update_counter(Key, Count, Db) -> - true = ets:insert(Db, {Key, Count}), - ok. +init_ref_db(Ref, File, {RefDb, FileMapDb}) -> + true = ets:insert(RefDb, {Ref, 1}), + true = ets:insert(FileMapDb, {File, Ref}). remove_certs(Ref, CertsDb) -> true = ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}), @@ -326,10 +308,10 @@ decode_certs(Ref, Cert) -> undefined end. -new_trusted_cert_entry(File, [CertsDb, RefDb, _ | _] = Db) -> +new_trusted_cert_entry(File, [CertsDb, RefsDb, _ | _]) -> Ref = make_ref(), - update_counter(Ref, 1, RefDb), - {ok, Content} = cache_pem_file(Ref, File, Db), + init_ref_db(Ref, File, RefsDb), + {ok, Content} = ssl_pem_cache:insert(File), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 8245801139..05a7aaaa82 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -25,7 +25,7 @@ -behaviour(supervisor). %% API --export([start_link/0, manager_opts/0]). +-export([start_link/0]). %% Supervisor callback -export([init/1]). @@ -44,90 +44,28 @@ start_link() -> %%%========================================================================= init([]) -> - SessionCertManager = session_and_cert_manager_child_spec(), - TLSConnetionManager = tls_connection_manager_child_spec(), - %% Handles emulated options so that they inherited by the accept - %% socket, even when setopts is performed on the listen socket - ListenOptionsTracker = listen_options_tracker_child_spec(), - - DTLSConnetionManager = dtls_connection_manager_child_spec(), - DTLSUdpListeners = dtls_udp_listeners_spec(), + {ok, {{rest_for_one, 10, 3600}, [ssl_admin_child_spec(), + ssl_connection_sup() + ]}}. - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, - ListenOptionsTracker, - DTLSConnetionManager, DTLSUdpListeners - ]}}. - - -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- - -session_and_cert_manager_child_spec() -> - Opts = manager_opts(), - Name = ssl_manager, - StartFunc = {ssl_manager, start_link, [Opts]}, +ssl_admin_child_spec() -> + Name = ssl_admin_sup, + StartFunc = {ssl_admin_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_manager], - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -tls_connection_manager_child_spec() -> - Name = tls_connection, - StartFunc = {tls_connection_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_connection_sup], + Modules = [ssl_admin_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -dtls_connection_manager_child_spec() -> - Name = dtls_connection, - StartFunc = {dtls_connection_sup, start_link, []}, +ssl_connection_sup() -> + Name = ssl_connection_sup, + StartFunc = {ssl_connection_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [dtls_connection_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -listen_options_tracker_child_spec() -> - Name = tls_socket, - StartFunc = {ssl_listen_tracker_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_socket], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -dtls_udp_listeners_spec() -> - Name = dtls_udp_listener, - StartFunc = {dtls_udp_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [], + Modules = [ssl_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -session_cb_init_args() -> - case application:get_env(ssl, session_cb_init_args) of - {ok, Args} when is_list(Args) -> - Args; - _ -> - [] - end. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 32991d3079..c6e530e164 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -48,7 +48,7 @@ -export([encode_data/3, encode_alert/3]). %% State transition handling --export([next_record/1, next_event/3]). +-export([next_record/1, next_event/3, next_event/4]). %% Handshake handling -export([renegotiate/2, send_handshake/2, @@ -59,7 +59,8 @@ -export([send_alert/2, close/5]). %% Data handling --export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3]). +-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3, + socket/5]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -117,7 +118,7 @@ send_handshake_flight(#state{socket = Socket, transport_cb = Transport, flight_buffer = Flight} = State0) -> send(Transport, Socket, Flight), - State0#state{flight_buffer = []}. + {State0#state{flight_buffer = []}, []}. queue_change_cipher(Msg, #state{negotiated_version = Version, flight_buffer = Flight0, @@ -191,6 +192,10 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) -> callback_mode() -> state_functions. +socket(Pid, Transport, Socket, Connection, Tracker) -> + tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). + + %%-------------------------------------------------------------------- %% State functions %%-------------------------------------------------------------------- @@ -340,12 +345,12 @@ connection(internal, #hello_request{}, renegotiation = {Renegotiation, _}} = State0) -> Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), - State1 = send_handshake(Hello, State0), + {State1, Actions} = send_handshake(Hello, State0), {Record, State} = next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State0) -> %% Mitigate Computational DoS attack @@ -424,18 +429,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, ssl_options = Options} = State0) -> try {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), - State = + State1 = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, - Events = tls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + case Packets of + [] -> + assert_buffer_sanity(Buf, Options), + {Record, State} = next_record(State1), + next_event(StateName, Record, State); + _ -> + Events = tls_handshake_events(Packets), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State1, Events); + _ -> + {next_state, StateName, + State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end + end catch throw:#alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State0) + ssl_connection:handle_own_alert(Alert, Version, StateName, State0) end; %%% TLS record protocol level application data messages handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> @@ -615,8 +628,6 @@ next_event(StateName, Record, State, Actions) -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. -tls_handshake_events([]) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -735,3 +746,25 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + + +assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when + Length =< Max -> + case size(Rest) of + N when N < Length -> + true; + N when N > Length -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + too_big_handshake_data)); + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end; +assert_buffer_sanity(Bin, _) -> + case size(Bin) of + N when N < 3 -> + true; + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 2800ee6537..f4803ce19f 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -192,7 +192,8 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, end. get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), - Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) -> + Body:Length/binary,Rest/binary>>, + #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) -> Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, try decode_handshake(Version, Type, Body, V2Hello) of Handshake -> @@ -207,27 +208,17 @@ get_tls_handshake_aux(_Version, Data, _, Acc) -> decode_handshake(_, ?HELLO_REQUEST, <<>>, _) -> #hello_request{}; -%% Client hello v2. -%% The server must be able to receive such messages, from clients that -%% are willing to use ssl v3 or higher, but have ssl v2 compatibility. -decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), - ?UINT16(CSLength), ?UINT16(0), - ?UINT16(CDLength), - CipherSuites:CSLength/binary, - ChallengeData:CDLength/binary>>, true) -> - #client_hello{client_version = {Major, Minor}, - random = ssl_v2:client_random(ChallengeData, CDLength), - session_id = 0, - cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites), - compression_methods = [?NULL], - extensions = #hello_extensions{} - }; -decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(_), ?BYTE(_), - ?UINT16(CSLength), ?UINT16(0), - ?UINT16(CDLength), - _CipherSuites:CSLength/binary, - _ChallengeData:CDLength/binary>>, false) -> - throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION, ssl_v2_client_hello_no_supported)); +decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) -> + try decode_hello(Bin) of + Hello -> + Hello + catch + _:_ -> + decode_v2_hello(Bin) + end; +decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) -> + decode_hello(Bin); + decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, @@ -244,10 +235,40 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3 compression_methods = Comp_methods, extensions = DecodedExtensions }; - decode_handshake(Version, Tag, Msg, _) -> ssl_handshake:decode_handshake(Version, Tag, Msg). + +decode_hello(<<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID:SID_length/binary, + ?UINT16(Cs_length), CipherSuites:Cs_length/binary, + ?BYTE(Cm_length), Comp_methods:Cm_length/binary, + Extensions/binary>>) -> + DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}), + + #client_hello{ + client_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), + compression_methods = Comp_methods, + extensions = DecodedExtensions + }. +%% The server must be able to receive such messages, from clients that +%% are willing to use ssl v3 or higher, but have ssl v2 compatibility. +decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor), + ?UINT16(CSLength), ?UINT16(0), + ?UINT16(CDLength), + CipherSuites:CSLength/binary, + ChallengeData:CDLength/binary>>) -> + #client_hello{client_version = {Major, Minor}, + random = ssl_v2:client_random(ChallengeData, CDLength), + session_id = 0, + cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites), + compression_methods = [?NULL], + extensions = #hello_extensions{} + }. + enc_handshake(#hello_request{}, _Version) -> {?HELLO_REQUEST, <<>>}; enc_handshake(#client_hello{client_version = {Major, Minor}, diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 7f24ce5192..32bcdf71c3 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -204,21 +204,21 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA + ?TLS_RSA_WITH_AES_128_CBC_SHA, + + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA ]; suites(3) -> [ diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index d85be6c69e..e14f7f60c4 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -172,8 +172,8 @@ revoke(Root, CA, User, C) -> gencrl(Root, CA, C). gencrl(Root, CA, C) -> - %% By default, the CRL is valid for 24 hours from now. - gencrl(Root, CA, C, 24). + %% By default, the CRL is valid for a week from now. + gencrl(Root, CA, C, 24*7). gencrl(Root, CA, C, CrlHours) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 52c1af5b4c..bff6d254f1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -53,7 +53,8 @@ all() -> {group, options_tls}, {group, session}, {group, 'dtlsv1.2'}, - %%{group, 'dtlsv1'}, + %% {group, 'dtlsv1'}, Breaks dtls in cert_verify_SUITE enable later when + %% problem is identified and fixed {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, @@ -65,15 +66,15 @@ groups() -> {basic_tls, [], basic_tests_tls()}, {options, [], options_tests()}, {options_tls, [], options_tests_tls()}, - %%{'dtlsv1.2', [], all_versions_groups()}, - {'dtlsv1.2', [], [connection_information]}, - %%{'dtlsv1', [], all_versions_groups()}, + {'dtlsv1.2', [], all_versions_groups()}, + {'dtlsv1', [], all_versions_groups()}, {'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()}, {'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]}, {api,[], api_tests()}, {api_tls,[], api_tests_tls()}, + {tls_ciphers,[], tls_cipher_tests()}, {session, [], session_tests()}, {renegotiate, [], renegotiate_tests()}, {ciphers, [], cipher_tests()}, @@ -83,12 +84,13 @@ groups() -> ]. tls_versions_groups ()-> - [{group, api_tls}, + [{group, renegotiate}, %% Should be in all_versions_groups not fixed for DTLS yet + {group, api_tls}, + {group, tls_ciphers}, {group, error_handling_tests_tls}]. all_versions_groups ()-> [{group, api}, - {group, renegotiate}, {group, ciphers}, {group, ciphers_ec}, {group, error_handling_tests}]. @@ -136,7 +138,8 @@ options_tests() -> honor_server_cipher_order, honor_client_cipher_order, unordered_protocol_versions_server, - unordered_protocol_versions_client + unordered_protocol_versions_client, + max_handshake_size ]. options_tests_tls() -> @@ -146,10 +149,8 @@ options_tests_tls() -> api_tests() -> [connection_info, connection_information, - peername, peercert, peercert_with_client_cert, - sockname, versions, eccs, controlling_process, @@ -161,7 +162,6 @@ api_tests() -> ssl_recv_timeout, server_name_indication_option, accept_pool, - new_options_in_accept, prf ]. @@ -174,7 +174,10 @@ api_tests_tls() -> tls_shutdown, tls_shutdown_write, tls_shutdown_both, - tls_shutdown_error + tls_shutdown_error, + peername, + sockname, + new_options_in_accept ]. session_tests() -> @@ -196,6 +199,11 @@ renegotiate_tests() -> renegotiate_dos_mitigate_passive, renegotiate_dos_mitigate_absolute]. +tls_cipher_tests() -> + [rc4_rsa_cipher_suites, + rc4_ecdh_rsa_cipher_suites, + rc4_ecdsa_cipher_suites]. + cipher_tests() -> [cipher_suites, cipher_suites_mix, @@ -211,9 +219,6 @@ cipher_tests() -> srp_cipher_suites, srp_anon_cipher_suites, srp_dsa_cipher_suites, - rc4_rsa_cipher_suites, - rc4_ecdh_rsa_cipher_suites, - rc4_ecdsa_cipher_suites, des_rsa_cipher_suites, des_ecdh_rsa_cipher_suites, default_reject_anonymous]. @@ -225,15 +230,15 @@ cipher_tests_ec() -> ciphers_ecdh_rsa_signed_certs_openssl_names]. error_handling_tests()-> - [controller_dies, - close_transport_accept, + [close_transport_accept, recv_active, recv_active_once, recv_error_handling ]. error_handling_tests_tls()-> - [tls_client_closes_socket, + [controller_dies, + tls_client_closes_socket, tls_tcp_error_propagation_in_active_mode, tls_tcp_connect, tls_tcp_connect_big, @@ -842,8 +847,7 @@ controller_dies(Config) when is_list(Config) -> Server ! listen, Tester = self(), Connect = fun(Pid) -> - {ok, Socket} = ssl:connect(Hostname, Port, - [{reuseaddr,true},{ssl_imp,new}]), + {ok, Socket} = ssl:connect(Hostname, Port, ClientOpts), %% Make sure server finishes and verification %% and is in coonection state before %% killing client @@ -960,9 +964,9 @@ clear_pem_cache(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [_,FilRefDb |_] = element(6, State), + [_,{FilRefDb, _} |_] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), - CountReferencedFiles = fun({_,-1}, Acc) -> + CountReferencedFiles = fun({_, -1}, Acc) -> Acc; ({_, N}, Acc) -> N + Acc @@ -2193,8 +2197,9 @@ ciphers_dsa_signed_certs() -> [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:dsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- @@ -2217,29 +2222,33 @@ anonymous_cipher_suites(Config) when is_list(Config) -> psk_cipher_suites() -> [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_suites(), + Ciphers = ssl_test_lib:psk_suites(NVersion), run_suites(Ciphers, Version, Config, psk). %%------------------------------------------------------------------- psk_with_hint_cipher_suites()-> [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}]. psk_with_hint_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_suites(), + Ciphers = ssl_test_lib:psk_suites(NVersion), run_suites(Ciphers, Version, Config, psk_with_hint). %%------------------------------------------------------------------- psk_anon_cipher_suites() -> [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_anon_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_anon_suites(), + Ciphers = ssl_test_lib:psk_anon_suites(NVersion), run_suites(Ciphers, Version, Config, psk_anon). %%------------------------------------------------------------------- psk_anon_with_hint_cipher_suites()-> [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}]. psk_anon_with_hint_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_anon_suites(), + Ciphers = ssl_test_lib:psk_anon_suites(NVersion), run_suites(Ciphers, Version, Config, psk_anon_with_hint). %%------------------------------------------------------------------- srp_cipher_suites()-> @@ -2290,18 +2299,17 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> %%------------------------------------------------------------------- des_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. + [{doc, "Test the des_rsa ciphersuites"}]. des_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), - Ciphers = ssl_test_lib:des_suites(NVersion), + Version = ssl_test_lib:protocol_version(Config), + Ciphers = ssl_test_lib:des_suites(Config), run_suites(Ciphers, Version, Config, des_rsa). %------------------------------------------------------------------- des_ecdh_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. + [{doc, "Test ECDH rsa signed ciphersuites"}]. des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:des_suites(NVersion), run_suites(Ciphers, Version, Config, des_dhe_rsa). @@ -2312,9 +2320,11 @@ default_reject_anonymous(Config) when is_list(Config) -> {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()), - [CipherSuite | _] = ssl_test_lib:anonymous_suites(Version), - + Version = ssl_test_lib:protocol_version(Config), + TLSVersion = ssl_test_lib:tls_version(Version), + + [CipherSuite | _] = ssl_test_lib:anonymous_suites(TLSVersion), + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {options, ServerOpts}]), @@ -2334,8 +2344,9 @@ ciphers_ecdsa_signed_certs() -> [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:ecdsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdsa). %%-------------------------------------------------------------------- @@ -2352,8 +2363,9 @@ ciphers_ecdh_rsa_signed_certs() -> [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdh_rsa). %%-------------------------------------------------------------------- @@ -3325,11 +3337,11 @@ hibernate(Config) -> process_info(Pid, current_function), ssl_test_lib:check_result(Server, ok, Client, ok), - timer:sleep(1100), - + + timer:sleep(1500), {current_function, {erlang, hibernate, 3}} = process_info(Pid, current_function), - + ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -3362,13 +3374,12 @@ hibernate_right_away(Config) -> [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), ssl_test_lib:check_result(Server1, ok, Client1, ok), - - {current_function, {erlang, hibernate, 3}} = + + {current_function, {erlang, hibernate, 3}} = process_info(Pid1, current_function), - ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), - + Server2 = ssl_test_lib:start_server(StartServerOpts), Port2 = ssl_test_lib:inet_port(Server2), {Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++ @@ -3376,8 +3387,8 @@ hibernate_right_away(Config) -> ssl_test_lib:check_result(Server2, ok, Client2, ok), - ct:sleep(100), %% Schedule out - + ct:sleep(1000), %% Schedule out + {current_function, {erlang, hibernate, 3}} = process_info(Pid2, current_function), @@ -3860,6 +3871,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). %%-------------------------------------------------------------------- +max_handshake_size() -> + [{doc,"Test that we can set max_handshake_size to max value."}]. + +max_handshake_size(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} |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, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%%-------------------------------------------------------------------- server_name_indication_option() -> [{doc,"Test API server_name_indication option to connect."}]. @@ -4483,16 +4517,21 @@ run_suites(Ciphers, Version, Config, Type) -> [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk, Config)}; + [{ciphers, ssl_test_lib:psk_suites(Version)} | + ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_hint, Config)}; + [{ciphers, ssl_test_lib:psk_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_hint, Config) + ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_anon, Config)}; + [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_anon_hint, Config)}; + [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), ssl_test_lib:ssl_options(server_srp, Config)}; @@ -4532,7 +4571,7 @@ run_suites(Ciphers, Version, Config, Type) -> Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - ssl_test_lib:filter_suites(Ciphers)), + ssl_test_lib:filter_suites(Ciphers, Version)), case lists:flatten(Result) of [] -> ok; diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5265c87e29..4552a4f57d 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -39,17 +39,26 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- all() -> - [{group, active}, - {group, passive}, - {group, active_once}, - {group, error_handling}]. - + [ + {group, tls}, + {group, dtls} + ]. groups() -> - [{active, [], tests()}, + [ + {tls, [], all_protocol_groups()}, + {dtls, [], all_protocol_groups()}, + {active, [], tests()}, {active_once, [], tests()}, {passive, [], tests()}, - {error_handling, [],error_handling_tests()}]. + {error_handling, [],error_handling_tests()} + ]. + +all_protocol_groups() -> + [{group, active}, + {group, passive}, + {group, active_once}, + {group, error_handling}]. tests() -> [verify_peer, @@ -85,7 +94,7 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - ssl_test_lib:clean_start(), + ssl_test_lib:clean_start(), %% make rsa certs using oppenssl {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), proplists:get_value(priv_dir, Config0)), @@ -99,6 +108,26 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). +init_per_group(tls, Config) -> + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, Version), + application:set_env(ssl, bypass_pem_cache, Version), + ssl:start(), + NewConfig = proplists:delete(protocol, Config), + [{protocol, tls}, {version, tls_record:protocol_version(Version)} | NewConfig]; + +init_per_group(dtls, Config) -> + Version = dtls_record:protocol_version(dtls_record:highest_protocol_version([])), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, Version), + application:set_env(ssl, bypass_pem_cache, Version), + ssl:start(), + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}, {version, dtls_record:protocol_version(Version)} | NewConfig]; + init_per_group(active, Config) -> [{active, true}, {receive_function, send_recv_result_active} | Config]; init_per_group(active_once, Config) -> @@ -262,7 +291,7 @@ server_require_peer_cert_fail() -> server_require_peer_cert_fail(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ssl_test_lib:ssl_options(server_verification_opts, Config)], - BadClientOpts = ssl_test_lib:ssl_options(client_opts, []), + BadClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, @@ -411,7 +440,7 @@ server_require_peer_cert_partial_chain_fun_fail() -> server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ssl_test_lib:ssl_options(server_verification_opts, Config)], - ClientOpts = proplists:get_value(client_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), @@ -1091,6 +1120,7 @@ client_with_cert_cipher_suites_handshake() -> client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> ClientOpts = ssl_test_lib:ssl_options(client_verification_opts_digital_signature_only, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -1098,7 +1128,7 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> send_recv_result_active, []}}, {options, [{active, true}, {ciphers, - ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))} + ssl_test_lib:rsa_non_signed_suites(proplists:get_value(version, Config))} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -1132,7 +1162,7 @@ server_verify_no_cacerts(Config) when is_list(Config) -> unknown_server_ca_fail() -> [{doc,"Test that the client fails if the ca is unknown in verify_peer mode"}]. unknown_server_ca_fail(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, @@ -1176,7 +1206,7 @@ unknown_server_ca_fail(Config) when is_list(Config) -> unknown_server_ca_accept_verify_none() -> [{doc,"Test that the client succeds if the ca is unknown in verify_none mode"}]. unknown_server_ca_accept_verify_none(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -1201,8 +1231,8 @@ unknown_server_ca_accept_verify_peer() -> [{doc, "Test that the client succeds if the ca is unknown in verify_peer mode" " with a verify_fun that accepts the unknown ca error"}]. unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> - ClientOpts =ssl_test_lib:ssl_options(client_opts, []), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -1240,7 +1270,7 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> unknown_server_ca_accept_backwardscompatibility() -> [{doc,"Test that old style verify_funs will work"}]. unknown_server_ca_accept_backwardscompatibility(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 74b14145dd..0a50c98a28 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -33,6 +33,7 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- all() -> [decode_hello_handshake, + decode_hello_handshake_version_confusion, decode_single_hello_extension_correctly, decode_supported_elliptic_curves_hello_extension_correctly, decode_unknown_hello_extension_correctly, @@ -106,6 +107,14 @@ decode_hello_handshake(_Config) -> #renegotiation_info{renegotiated_connection = <<0>>} = (Hello#server_hello.extensions)#hello_extensions.renegotiation_info. + +decode_hello_handshake_version_confusion(_) -> + HelloPacket = <<3,3,0,0,0,0,0,63,210,235,149,6,244,140,108,13,177,74,16,218,33,108,219,41,73,228,3,82,132,123,73,144,118,100,0,0,32,192,4,0,10,192,45,192,38,0,47,192,18,0,163,0,22,0,165,192,29,192,18,192,30,0,103,0,57,192,48,0,47,1,0>>, + Version = {3,3}, + ClientHello = 1, + Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, false), + Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, true). + decode_single_hello_extension_correctly(_Config) -> Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, Extensions = ssl_handshake:decode_hello_extensions(Renegotiation), diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index 69aeea10c5..0b1de1dc1c 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -50,6 +50,10 @@ init_per_suite(Config) -> {skip, "Crypto did not start"} end. +end_per_suite(_Config) -> + %% This function is required since init_per_suite/1 exists. + ok. + init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 5}), diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index f10d27fbc6..96b15d9b51 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -82,8 +82,8 @@ pem_cleanup() -> [{doc, "Test pem cache invalidate mechanism"}]. pem_cleanup(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_opts, Config), - ServerOpts = proplists:get_value(server_opts, Config), + ClientOpts = proplists:get_value(client_verification_opts, Config), + ServerOpts = proplists:get_value(server_verification_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 9632103696..7a644968f2 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -278,8 +278,11 @@ check_result(Server, ServerMsg, Client, ClientMsg) -> check_result(Server, ServerMsg); {Port, {data,Debug}} when is_port(Port) -> - ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), + ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]), check_result(Server, ServerMsg, Client, ClientMsg); + {Port,closed} when is_port(Port) -> + ct:log("~p:~p~n Openssl port ~n",[?MODULE,?LINE]), + check_result(Server, ServerMsg, Client, ClientMsg); Unexpected -> Reason = {{expected, {Client, ClientMsg}}, {expected, {Server, ServerMsg}}, {got, Unexpected}}, @@ -291,11 +294,11 @@ check_result(Pid, Msg) -> {Pid, Msg} -> ok; {Port, {data,Debug}} when is_port(Port) -> - ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]), + ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]), check_result(Pid,Msg); - %% {Port, {exit_status, Status}} when is_port(Port) -> - %% ct:log("~p:~p Exit status: ~p~n",[?MODULE,?LINE, Status]), - %% check_result(Pid, Msg); + {Port,closed} when is_port(Port)-> + ct:log("~p:~p Openssl port closed ~n",[?MODULE,?LINE]), + check_result(Pid, Msg); Unexpected -> Reason = {{expected, {Pid, Msg}}, {got, Unexpected}}, @@ -398,27 +401,22 @@ cert_options(Config) -> {ssl_imp, new}]}, {server_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, - %%{server_anon, [{ssl_imp, new},{reuseaddr, true}, {ciphers, anonymous_suites()}]}, - {client_psk, [{ssl_imp, new},{reuseaddr, true}, + {client_psk, [{ssl_imp, new}, {psk_identity, "Test-User"}, {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_hint, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {psk_identity, "HINT"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_anon, [{ssl_imp, new},{reuseaddr, true}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_anon_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_anon_hint, [{ssl_imp, new},{reuseaddr, true}, {psk_identity, "HINT"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_anon_suites()}]}, - {client_srp, [{ssl_imp, new},{reuseaddr, true}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, + {client_srp, [{ssl_imp, new}, {srp_identity, {"Test-User", "secret"}}]}, {server_srp, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, @@ -473,7 +471,7 @@ make_dsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_dsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}, {server_srp_dsa, [{ssl_imp, new},{reuseaddr, true}, @@ -481,7 +479,7 @@ make_dsa_cert(Config) -> {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {user_lookup_fun, {fun user_lookup/3, undefined}}, {ciphers, srp_dss_suites()}]}, - {client_srp_dsa, [{ssl_imp, new},{reuseaddr, true}, + {client_srp_dsa, [{ssl_imp, new}, {srp_identity, {"Test-User", "secret"}}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} @@ -502,7 +500,7 @@ make_ecdsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_ecdsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]; @@ -537,7 +535,7 @@ make_ecdh_rsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_ecdh_rsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]; @@ -557,7 +555,7 @@ make_mix_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_mix_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_mix_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]. @@ -827,17 +825,17 @@ rsa_suites(CounterPart) -> ({dhe_rsa, des_cbc, sha}) when FIPS == true -> false; ({rsa, Cipher, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({dhe_rsa, Cipher, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({ecdhe_rsa, Cipher, _}) when ECC == true -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({rsa, Cipher, _, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({dhe_rsa, Cipher, _,_}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({ecdhe_rsa, Cipher, _,_}) when ECC == true -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); (_) -> false end, @@ -930,44 +928,12 @@ anonymous_suites(Version) -> Suites = ssl_cipher:anonymous_suites(Version), ssl_cipher:filter_suites(Suites). -psk_suites() -> - Suites = - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {psk, aes_128_cbc, sha256}, - {psk, aes_256_cbc, sha384}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}, - {dhe_psk, aes_128_cbc, sha256}, - {dhe_psk, aes_256_cbc, sha384}, - {rsa_psk, rc4_128, sha}, - {rsa_psk, '3des_ede_cbc', sha}, - {rsa_psk, aes_128_cbc, sha}, - {rsa_psk, aes_256_cbc, sha}, - {rsa_psk, aes_128_cbc, sha256}, - {rsa_psk, aes_256_cbc, sha384}, - {psk, aes_128_gcm, null, sha256}, - {psk, aes_256_gcm, null, sha384}, - {dhe_psk, aes_128_gcm, null, sha256}, - {dhe_psk, aes_256_gcm, null, sha384}, - {rsa_psk, aes_128_gcm, null, sha256}, - {rsa_psk, aes_256_gcm, null, sha384}], +psk_suites(Version) -> + Suites = ssl_cipher:psk_suites(Version), ssl_cipher:filter_suites(Suites). -psk_anon_suites() -> - Suites = - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}], +psk_anon_suites(Version) -> + Suites = [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)], ssl_cipher:filter_suites(Suites). srp_suites() -> @@ -1089,14 +1055,16 @@ init_tls_version(Version, Config) application:load(ssl), application:set_env(ssl, dtls_protocol_version, Version), ssl:start(), - [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}|Config]; + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]} | NewConfig]; init_tls_version(Version, Config) -> ssl:stop(), application:load(ssl), application:set_env(ssl, protocol_version, Version), ssl:start(), - [{protocol, tls}|Config]. + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, tls} | NewConfig]. sufficient_crypto_support(Version) when Version == 'tlsv1.2'; Version == 'dtlsv1.2' -> @@ -1231,19 +1199,37 @@ check_sane_openssl_version(Version) -> enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; enough_openssl_crl_support(_) -> true. -wait_for_openssl_server(Port) -> - wait_for_openssl_server(Port, 10). -wait_for_openssl_server(_, 0) -> +wait_for_openssl_server(Port, tls) -> + do_wait_for_openssl_tls_server(Port, 10); +wait_for_openssl_server(Port, dtls) -> + do_wait_for_openssl_dtls_server(Port, 10). + +do_wait_for_openssl_tls_server(_, 0) -> exit(failed_to_connect_to_openssl); -wait_for_openssl_server(Port, N) -> +do_wait_for_openssl_tls_server(Port, N) -> case gen_tcp:connect("localhost", Port, []) of {ok, S} -> gen_tcp:close(S); _ -> ct:sleep(?SLEEP), - wait_for_openssl_server(Port, N-1) + do_wait_for_openssl_tls_server(Port, N-1) end. +do_wait_for_openssl_dtls_server(_, 0) -> + %%exit(failed_to_connect_to_openssl); + ok; +do_wait_for_openssl_dtls_server(Port, N) -> + %% case gen_udp:open(0) of + %% {ok, S} -> + %% gen_udp:connect(S, "localhost", Port), + %% gen_udp:close(S); + %% _ -> + %% ct:sleep(?SLEEP), + %% do_wait_for_openssl_dtls_server(Port, N-1) + %% end. + ct:sleep(500), + do_wait_for_openssl_dtls_server(Port, N-1). + version_flag(tlsv1) -> "-tls1"; version_flag('tlsv1.1') -> @@ -1253,10 +1239,14 @@ version_flag('tlsv1.2') -> version_flag(sslv3) -> "-ssl3"; version_flag(sslv2) -> - "-ssl2". - -filter_suites(Ciphers0) -> - Version = tls_record:highest_protocol_version([]), + "-ssl2"; +version_flag('dtlsv1.2') -> + "-dtls1_2"; +version_flag('dtlsv1') -> + "-dtls1". + +filter_suites(Ciphers0, AtomVersion) -> + Version = tls_version(AtomVersion), Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) @@ -1338,7 +1328,7 @@ protocol_version(Config) -> protocol_version(Config, tuple) -> case proplists:get_value(protocol, Config) of dtls -> - dtls_record:protocol_version(dtls_record:highest_protocol_version([])); + dtls_record:highest_protocol_version(dtls_record:supported_protocol_versions()); _ -> tls_record:highest_protocol_version(tls_record:supported_protocol_versions()) end; @@ -1372,6 +1362,7 @@ clean_env() -> application:unset_env(ssl, session_cache_client_max), application:unset_env(ssl, session_cache_server_max), application:unset_env(ssl, ssl_pem_cache_clean), + application:unset_env(ssl, bypass_pem_cache), application:unset_env(ssl, alert_timeout). clean_start() -> @@ -1379,3 +1370,105 @@ clean_start() -> application:load(ssl), clean_env(), ssl:start(). + +is_psk_anon_suite({psk, _,_}) -> + true; +is_psk_anon_suite({dhe_psk,_,_}) -> + true; +is_psk_anon_suite({psk, _,_,_}) -> + true; +is_psk_anon_suite({dhe_psk, _,_,_}) -> + true; +is_psk_anon_suite(_) -> + false. + +cipher_atom(aes_256_cbc) -> + aes_cbc256; +cipher_atom(aes_128_cbc) -> + aes_cbc128; +cipher_atom('3des_ede_cbc') -> + des_ede3; +cipher_atom(Atom) -> + Atom. +tls_version('dtlsv1' = Atom) -> + dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom)); +tls_version('dtlsv1.2' = Atom) -> + dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom)); +tls_version(Atom) -> + tls_record:protocol_version(Atom). + +dtls_hello() -> + [1, + <<0,1,4>>, + <<0,0>>, + <<0,0,0>>, + <<0,1,4>>, + <<254,253,88, + 156,129,61, + 131,216,15, + 131,194,242, + 46,154,190, + 20,228,234, + 234,150,44, + 62,96,96,103, + 127,95,103, + 23,24,42,138, + 13,142,32,57, + 230,177,32, + 210,154,152, + 188,121,134, + 136,53,105, + 118,96,106, + 103,231,223, + 133,10,165, + 50,32,211, + 227,193,14, + 181,143,48, + 66,0,0,100,0, + 255,192,44, + 192,48,192, + 36,192,40, + 192,46,192, + 50,192,38, + 192,42,0,159, + 0,163,0,107, + 0,106,0,157, + 0,61,192,43, + 192,47,192, + 35,192,39, + 192,45,192, + 49,192,37, + 192,41,0,158, + 0,162,0,103, + 0,64,0,156,0, + 60,192,10, + 192,20,0,57, + 0,56,192,5, + 192,15,0,53, + 192,8,192,18, + 0,22,0,19, + 192,3,192,13, + 0,10,192,9, + 192,19,0,51, + 0,50,192,4, + 192,14,0,47, + 1,0,0,86,0,0, + 0,14,0,12,0, + 0,9,108,111, + 99,97,108, + 104,111,115, + 116,0,10,0, + 58,0,56,0,14, + 0,13,0,25,0, + 28,0,11,0,12, + 0,27,0,24,0, + 9,0,10,0,26, + 0,22,0,23,0, + 8,0,6,0,7,0, + 20,0,21,0,4, + 0,5,0,18,0, + 19,0,1,0,2,0, + 3,0,15,0,16, + 0,17,0,11,0, + 2,1,0>>]. + diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index e99340822d..7a1dce70c2 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -42,7 +42,9 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'} + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} ]. groups() -> @@ -50,7 +52,10 @@ groups() -> {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, - {'sslv3', [], all_versions_tests()}]. + {'sslv3', [], all_versions_tests()}, + {'dtlsv1.2', [], dtls_all_versions_tests()}, + {'dtlsv1', [], dtls_all_versions_tests()} + ]. basic_tests() -> [basic_erlang_client_openssl_server, @@ -78,6 +83,25 @@ all_versions_tests() -> expired_session, ssl2_erlang_server_openssl_client ]. +dtls_all_versions_tests() -> + [ + %%erlang_client_openssl_server, + erlang_server_openssl_client, + %%erlang_client_openssl_server_dsa_cert, + erlang_server_openssl_client_dsa_cert + %% This one works but gets port EXIT first some times + %%erlang_server_openssl_client_reuse_session + %%erlang_client_openssl_server_renegotiate, + %%erlang_client_openssl_server_nowrap_seqnum, + %%erlang_server_openssl_client_nowrap_seqnum, + %%erlang_client_openssl_server_no_server_ca_cert, + %%erlang_client_openssl_server_client_cert, + %%erlang_server_openssl_client_client_cert + %%ciphers_rsa_signed_certs, + %%ciphers_dsa_signed_certs, + %%erlang_client_bad_openssl_server, + %%expired_session + ]. alpn_tests() -> [erlang_client_alpn_openssl_server_alpn, @@ -284,7 +308,8 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + + ssl_test_lib:wait_for_openssl_server(Port, tls), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -357,7 +382,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -431,7 +456,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -551,7 +576,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -600,7 +625,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -681,7 +706,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -724,7 +749,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -856,7 +881,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -911,7 +936,7 @@ expired_session(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, tls), Client0 = ssl_test_lib:start_client([{node, ClientNode}, @@ -1399,7 +1424,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), ConnectionInfo = {ok, {Version, CipherSuite}}, @@ -1469,7 +1494,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1505,7 +1530,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1574,7 +1599,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1639,7 +1664,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 2cdb825d75..415a47949d 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.1 +SSL_VSN = 8.1.1 diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index 2a413835d0..f7f3f7b504 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -511,6 +511,33 @@ true </func> <func> + <name name="safe_relative_path" arity="1"/> + <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary> + <desc> + <p>Sanitizes the relative path by eliminating ".." and "." + components to protect against directory traversal attacks. + Either returns the sanitized path name, or the atom + <c>unsafe</c> if the path is unsafe. + The path is considered unsafe in the following circumstances:</p> + <list type="bulleted"> + <item><p>The path is not relative.</p></item> + <item><p>A ".." component would climb up above the root of + the relative path.</p></item> + </list> + <p><em>Examples:</em></p> + <pre> +1> <input>filename:safe_relative_path("dir/sub_dir/..").</input> +"dir" +2> <input>filename:safe_relative_path("dir/..").</input> +[] +3> <input>filename:safe_relative_path("dir/../..").</input> +unsafe +4> <input>filename:safe_relative_path("/abs/path").</input> +unsafe</pre> + </desc> + </func> + + <func> <name name="split" arity="1"/> <fsummary>Split a filename into its path components.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index fd498ee82e..5eb13db1aa 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2016</year> + <year>2016-2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -587,8 +587,8 @@ handle_event(_, _, State, Data) -> <name name="state_enter"/> <desc> <p> - If the state machine should use <em>state enter calls</em> - is selected when starting the <c>gen_statem</c> + Whether the state machine should use <em>state enter calls</em> + or not is selected when starting the <c>gen_statem</c> and after code change using the return value from <seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>. </p> @@ -606,7 +606,16 @@ handle_event(_, _, State, Data) -> See <seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso> and - <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>. + <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>. + Such a call can be repeated by returning a + <seealso marker="#type-state_callback_result"> + <c>repeat_state</c> + </seealso> + or + <seealso marker="#type-state_callback_result"> + <c>repeat_state_and_data</c> + </seealso> + tuple from the state callback. </p> <p> If @@ -625,7 +634,8 @@ handle_event(_, _, State, Data) -> right before entering the initial state even though this formally is not a state change. In this case <c>OldState</c> will be the same as <c>State</c>, - which can not happen for a subsequent state change. + which can not happen for a subsequent state change, + but will happen when repeating the state enter call. </p> </desc> </datatype> @@ -640,7 +650,15 @@ handle_event(_, _, State, Data) -> <list type="ordered"> <item> <p> - If the state changes or is the initial state, and + If the state changes, is the initial state, + <seealso marker="#type-state_callback_result"> + <c>repeat_state</c> + </seealso> + or + <seealso marker="#type-state_callback_result"> + <c>repeat_state_and_data</c> + </seealso> + is used, and also <seealso marker="#type-state_enter"><em>state enter calls</em></seealso> are used, the <c>gen_statem</c> calls the new state callback with arguments @@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) -> </desc> </datatype> <datatype> + <name name="init_result"/> + <desc> + <p> + For a succesful initialization, + <c><anno>State</anno></c> is the initial + <seealso marker="#type-state"><c>state()</c></seealso> + and <c><anno>Data</anno></c> the initial server + <seealso marker="#type-data"><c>data()</c></seealso> + of the <c>gen_statem</c>. + </p> + <p> + The <seealso marker="#type-action"><c>Actions</c></seealso> + are executed when entering the first + <seealso marker="#type-state">state</seealso> just as for a + <seealso marker="#state callback">state callback</seealso>, + except that the action <c>postpone</c> is forced to + <c>false</c> since there is no event to postpone. + </p> + <p> + For an unsuccesful initialization, + <c>{stop,<anno>Reason</anno>}</c> + or <c>ignore</c> should be used; see + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. + </p> + </desc> + </datatype> + <datatype> <name name="state_enter_result"/> <desc> <p> @@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) -> <c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>. </p> </item> + <tag><c>repeat_state</c></tag> + <item> + <p> + The <c>gen_statem</c> keeps the current state, or + does a state transition to the current state if you like, + sets <c><anno>NewData</anno></c>, + and executes all <c><anno>Actions</anno></c>. + If the <c>gen_statem</c> runs with + <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>, + the state enter call is repeated, see type + <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>, + otherwise <c>repeat_state</c> is the same as + <c>keep_state</c>. + </p> + </item> + <tag><c>repeat_state_and_data</c></tag> + <item> + <p> + The <c>gen_statem</c> keeps the current state and data, or + does a state transition to the current state if you like, + and executes all <c><anno>Actions</anno></c>. + This is the same as + <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>. + If the <c>gen_statem</c> runs with + <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>, + the state enter call is repeated, see type + <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>, + otherwise <c>repeat_state_and_data</c> is the same as + <c>keep_state_and_data</c>. + </p> + </item> <tag><c>stop</c></tag> <item> <p> @@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) -> It is recommended to use an atom as <c>Reason</c> since it will be wrapped in an <c>{error,Reason}</c> tuple. </p> + <p> + Also note when upgrading a <c>gen_statem</c>, + this function and hence + the <c>Change={advanced,Extra}</c> parameter in the + <seealso marker="sasl:appup"><c>appup</c></seealso> file + is not only needed to update the internal state + or to act on the <c>Extra</c> argument. + It is also needed if an upgrade or downgrade should change + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>, + or else the callback mode after the code change + will not be honoured, + most probably causing a server crash. + </p> </desc> </func> <func> - <name>Module:init(Args) -> Result</name> + <name>Module:init(Args) -> Result(StateType)</name> <fsummary> Optional function for initializing process and internal state. </fsummary> <type> <v>Args = term()</v> - <v>Result = {ok,State,Data}</v> - <v> | {ok,State,Data,Actions}</v> - <v> | {stop,Reason} | ignore</v> - <v>State = <seealso marker="#type-state">state()</seealso></v> - <v> - Data = <seealso marker="#type-data">data()</seealso> - </v> <v> - Actions = - [<seealso marker="#type-action">action()</seealso>] | - <seealso marker="#type-action">action()</seealso> + Result(StateType) = + <seealso marker="#type-init_result">init_result(StateType)</seealso> </v> - <v>Reason = term()</v> </type> <desc> <marker id="Module:init-1"/> @@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) -> the implementation state and server data. </p> <p> - <c>Args</c> is the <c>Args</c> argument provided to the start + <c>Args</c> is the <c>Args</c> argument provided to that start function. </p> - <p> - If the initialization is successful, the function is to - return <c>{ok,State,Data}</c> or - <c>{ok,State,Data,Actions}</c>. - <c>State</c> is the initial - <seealso marker="#type-state"><c>state()</c></seealso> - and <c>Data</c> the initial server - <seealso marker="#type-data"><c>data()</c></seealso>. - </p> - <p> - The <seealso marker="#type-action"><c>Actions</c></seealso> - are executed when entering the first - <seealso marker="#type-state">state</seealso> just as for a - <seealso marker="#state callback">state callback</seealso>. - </p> - <p> - If the initialization fails, - the function is to return <c>{stop,Reason}</c> - or <c>ignore</c>; see - <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. - </p> <note> <p> This callback is optional, so a callback module does not need @@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) -> <seealso marker="#type-enter_action">actions</seealso> that may be returned: <seealso marker="#type-postpone"><c>postpone()</c></seealso> - and + is not allowed since a <em>state enter call</em> is not + an event so there is no event to postpone, and <seealso marker="#type-action"><c>{next_event,_,_}</c></seealso> - are not allowed. + is not allowed since using <em>state enter calls</em> + should not affect how events are consumed and produced. You may also not change states from this call. Should you return <c>{next_state,NextState, ...}</c> with <c>NextState =/= State</c> the <c>gen_statem</c> crashes. - You are advised to use <c>{keep_state,...}</c> or - <c>keep_state_and_data</c>. + It is possible to use <c>{repeat_state, ...}</c>, + <c>{repeat_state_and_data,_}</c> or + <c>repeat_state_and_data</c> but all of them makes little + sense since you immediately will be called again with a new + <em>state enter call</em> making this just a weird way + of looping, and there are better ways to loop in Erlang. + You are advised to use <c>{keep_state,...}</c>, + <c>{keep_state_and_data,_}</c> or + <c>keep_state_and_data</c> since you can not change states + from a <em>state enter call</em> anyway. </p> <p> Note the fact that you can use <seealso marker="erts:erlang#throw/1"><c>throw</c></seealso> to return the result, which can be useful. For example to bail out with <c>throw(keep_state_and_data)</c> - from deep within complex code that is in no position to - return <c>{next_state,State,Data}</c>. + from deep within complex code that can not + return <c>{next_state,State,Data}</c> because + <c>State</c> or <c>Data</c> is no longer in scope. </p> </desc> </func> @@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) -> <v>Ignored = term()</v> </type> <desc> + <note> + <p>This callback is optional, so callback modules need not + export it. The <c>gen_statem</c> module provides a default + implementation without cleanup.</p> + </note> <p> This function is called by a <c>gen_statem</c> when it is about to terminate. It is to be the opposite of diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 9091a46df9..45171f814d 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -83,8 +83,8 @@ <p>If the modules used to implement the process change dynamically during runtime, the process must understand one more message. An example is the <seealso marker="gen_event"><c>gen_event</c></seealso> - processes. The message is <c>{get_modules, From}</c>. - The reply to this message is <c>From ! {modules, Modules}</c>, where + processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>. + The reply to this message is <c>From ! {Ref, Modules}</c>, where <c>Modules</c> is a list of the currently active modules in the process.</p> <p>This message is used by the release handler to find which diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 5f821caef0..a1a97af4c5 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-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. @@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) -> %% Return the list of names L in multiple columns. format_matches(L) -> - S = format_col(lists:sort(L), []), + {S1, Dots} = format_col(lists:sort(L), []), + S = case Dots of + true -> + {_, Prefix} = longest_common_head(vals(L)), + PrefixLen = length(Prefix), + case PrefixLen =< 3 of + true -> S1; % Do not replace the prefix with "...". + false -> + LeadingDotsL = leading_dots(L, PrefixLen), + {S2, _} = format_col(lists:sort(LeadingDotsL), []), + S2 + end; + false -> S1 + end, ["\n" | S]. format_col([], _) -> []; -format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc). - -format_col(X, Width, Len, Acc) when Width + Len > 79 -> - format_col(X, Width, 0, ["\n" | Acc]); -format_col([A|T], Width, Len, Acc0) -> - H = case A of - %% If it's a tuple {string(), integer()}, we assume it's an - %% arity, and meant to be printed. - {H0, I} when is_integer(I) -> - H0 ++ "/" ++ integer_to_list(I); - {H1, _} -> H1; - H2 -> H2 - end, - Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0], - format_col(T, Width, Len+Width, Acc); -format_col([], _, _, Acc) -> - lists:reverse(Acc, "\n"). - -field_width(L) -> field_width(L, 0). - -field_width([{H,_}|T], W) -> +format_col(L, Acc) -> + LL = 79, + format_col(L, field_width(L, LL), 0, Acc, LL, false). + +format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL -> + format_col(X, Width, 0, ["\n" | Acc], LL, Dots); +format_col([A|T], Width, Len, Acc0, LL, Dots) -> + {H0, R} = format_val(A), + Hmax = LL - length(R), + {H, NewDots} = + case length(H0) > Hmax of + true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true}; + false -> {H0, Dots} + end, + Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0], + format_col(T, Width, Len+Width, Acc, LL, NewDots); +format_col([], _, _, Acc, _LL, Dots) -> + {lists:reverse(Acc, "\n"), Dots}. + +format_val({H, I}) when is_integer(I) -> + %% If it's a tuple {string(), integer()}, we assume it's an + %% arity, and meant to be printed. + {H, "/" ++ integer_to_list(I)}; +format_val({H, _}) -> + {H, ""}; +format_val(H) -> + {H, ""}. + +field_width(L, LL) -> field_width(L, 0, LL). + +field_width([{H,_}|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([H|T], W) -> +field_width([H|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([], W) when W < 40 -> +field_width([], W, LL) when W < LL - 3 -> W + 4; -field_width([], _) -> - 40. +field_width([], _, LL) -> + LL. + +vals([]) -> []; +vals([{S, _}|L]) -> [S|vals(L)]; +vals([S|L]) -> [S|vals(L)]. + +leading_dots([], _Len) -> []; +leading_dots([{H, I}|L], Len) -> + [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)]; +leading_dots([H|L], Len) -> + ["..." ++ nthtail(Len, H)|leading_dots(L, Len)]. longest_common_head([]) -> no; diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 40a34aa30f..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1306,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 4f38256e6b..d2dd2848b5 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. @@ -156,6 +156,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. +type -> char : '$1'. type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. @@ -1557,13 +1558,17 @@ new_anno(Term) -> Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> - map_anno(fun erl_anno:to_term/1, Abstract). + F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end, + {NewAbstract, []} = modify_anno1(Abstract, [], F), + NewAbstract. -spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> - map_anno(fun erl_anno:from_term/1, Term). + F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end, + {NewTerm, []} = modify_anno1(Term, [], F), + NewTerm. %% Forms. %% Recognize what sys_pre_expand does: diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 7f5ef4df42..c42ae981e7 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> %% Look for special comment on second line Line2 = get_line(Fd), {ok, HeaderSz2} = file:position(Fd, cur), - case classify_line(Line2) of - emu_args -> - %% Skip special comment on second line - Line3 = get_line(Fd), - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = undefined, - emu_args = Line2}}; - Line2Type -> - %% Look for special comment on third line - Line3 = get_line(Fd), - {ok, HeaderSz3} = file:position(Fd, cur), - Line3Type = classify_line(Line3), - if - Line3Type =:= emu_args -> - %% Skip special comment on third line - Line4 = get_line(Fd), - {HeaderSz3, LineNo + 3, Fd, - Sections#sections{type = guess_type(Line4), - comment = Line2, - emu_args = Line3}}; - Sections#sections.shebang =:= undefined, - KeepFirst =:= true -> - %% No shebang. Use the entire file - {HeaderSz0, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Sections#sections.shebang =:= undefined -> - %% No shebang. Skip the first line - {HeaderSz1, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Line2Type =:= comment -> - %% Skip shebang on first line and comment on second - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = Line2}}; - true -> - %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, Fd, - Sections#sections{type = guess_type(Line2)}} - end + if + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + true -> + case classify_line(Line2) of + emu_args -> + %% Skip special comment on second line + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + comment -> + %% Look for special comment on third line + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> + %% Skip special comment on third line + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + true -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}} + end; + _ -> + %% Just skip shebang on first line + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} + end end. classify_line(Line) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index c4586171ca..5d60b3837e 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -34,7 +34,8 @@ -export([absname/1, absname/2, absname_join/2, basename/1, basename/2, dirname/1, extension/1, join/1, join/2, pathtype/1, - rootname/1, rootname/2, split/1, nativename/1]). + rootname/1, rootname/2, split/1, nativename/1, + safe_relative_path/1]). -export([find_src/1, find_src/2, flatten/1]). -export([basedir/2, basedir/3]). @@ -750,6 +751,39 @@ separators() -> _ -> {false, false} end. +-spec safe_relative_path(Filename) -> 'unsafe' | SafeFilename when + Filename :: file:name_all(), + SafeFilename :: file:name_all(). + +safe_relative_path(Path) -> + case pathtype(Path) of + relative -> + Cs0 = split(Path), + safe_relative_path_1(Cs0, []); + _ -> + unsafe + end. + +safe_relative_path_1(["."|T], Acc) -> + safe_relative_path_1(T, Acc); +safe_relative_path_1([<<".">>|T], Acc) -> + safe_relative_path_1(T, Acc); +safe_relative_path_1([".."|T], Acc) -> + climb(T, Acc); +safe_relative_path_1([<<"..">>|T], Acc) -> + climb(T, Acc); +safe_relative_path_1([H|T], Acc) -> + safe_relative_path_1(T, [H|Acc]); +safe_relative_path_1([], []) -> + []; +safe_relative_path_1([], Acc) -> + join(lists:reverse(Acc)). + +climb(_, []) -> + unsafe; +climb(T, [_|Acc]) -> + safe_relative_path_1(T, Acc). + %% find_src(Module) -- diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index ccacf658e9..e55cdddb9a 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -742,7 +742,7 @@ stop_handlers([], _) -> []. %% Message from the release_handler. -%% The list of modules got to be a set ! +%% The list of modules got to be a set, i.e. no duplicate elements! get_modules(MSL) -> Mods = [Handler#handler.module || Handler <- MSL], ordsets:to_list(ordsets:from_list(Mods)). diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 018aca90e6..cacc932ec4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016. All Rights Reserved. +%% Copyright Ericsson AB 2016-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,15 +47,17 @@ %% Type exports for templates and callback modules -export_type( [event_type/0, - init_result/0, callback_mode_result/0, - state_function_result/0, - handle_event_result/0, + init_result/1, state_enter_result/1, event_handler_result/1, reply_action/0, enter_action/0, action/0]). +%% Old types, not advertised +-export_type( + [state_function_result/0, + handle_event_result/0]). %% Type that is exported just to be documented -export_type([transition_option/0]). @@ -143,9 +145,10 @@ {'reply', % Reply to a caller From :: from(), Reply :: term()}. --type init_result() :: - {ok, state(), data()} | - {ok, state(), data(), [action()] | action()} | +-type init_result(StateType) :: + {ok, State :: StateType, Data :: data()} | + {ok, State :: StateType, Data :: data(), + Actions :: [action()] | action()} | 'ignore' | {'stop', Reason :: term()}. @@ -182,12 +185,23 @@ 'keep_state_and_data' | % {keep_state_and_data,[]} {'keep_state_and_data', % Keep state and data -> only actions Actions :: [ActionType] | ActionType} | + %% + {'repeat_state', % {repeat_state,NewData,[]} + NewData :: data()} | + {'repeat_state', % Repeat state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'repeat_state_and_data' | % {repeat_state_and_data,[]} + {'repeat_state_and_data', % Repeat state and data -> only actions + Actions :: [ActionType] | ActionType} | + %% 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | {'stop', % Stop the server Reason :: term(), NewData :: data()} | + %% {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action()} | @@ -201,7 +215,7 @@ %% the server is not running until this function has returned %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. --callback init(Args :: term()) -> init_result(). +-callback init(Args :: term()) -> init_result(state()). %% This callback shall return the callback mode of the callback module. %% @@ -275,6 +289,8 @@ -optional_callbacks( [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation + terminate/3, % Has got a default implementation + code_change/4, % Only needed by advanced soft upgrade %% state_name/3, % Example for callback_mode() =:= state_functions: %% there has to be a StateName/3 callback function @@ -304,12 +320,16 @@ event_type({call,From}) -> from(From); event_type(Type) -> case Type of + {call,From} -> + from(From); cast -> true; info -> true; timeout -> true; + state_timeout -> + true; internal -> true; _ -> @@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> true -> [Actions,{postpone,false}] end, + TimerRefs = #{}, + %% Key: timer ref + %% Value: the timer type i.e the timer's event type + %% + TimerTypes = #{}, + %% Key: timer type i.e the timer's event type + %% Value: timer ref + %% + %% We add a timer to both timer_refs and timer_types + %% when we start it. When we request an asynchronous + %% timer cancel we remove it from timer_types. When + %% the timer cancel message arrives we remove it from + %% timer_refs. + %% + Hibernate = false, + CancelTimers = 0, S = #{ callback_mode => undefined, state_enter => false, @@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> state => State, data => Data, postponed => P, - %% The rest of the fields are set from to the arguments to - %% loop_event_actions/10 when it finally loops back to loop/3 - %% in loop_events/10 %% - %% Marker for initial state, cleared immediately when used - init_state => true + %% The following fields are finally set from to the arguments to + %% loop_event_actions/9 when it finally loops back to loop/3 + %% in loop_event_result/11 + timer_refs => TimerRefs, + timer_types => TimerTypes, + hibernate => Hibernate, + cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> - TimerRefs = #{}, - TimerTypes = #{}, loop_event_actions( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, State, Data, NewActions); + Parent, NewDebug, NewS, + Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - NewDebug, S, [Event|Events]) + Class, Reason, Stacktrace, NewDebug, + S, [Event|Events]) end. %%%========================================================================== @@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). system_terminate(Reason, _Parent, Debug, S) -> - terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, []). + terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( #{module := Module, @@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) -> %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 -loop(Parent, Debug, #{hibernate := Hibernate} = S) -> - case Hibernate of - true -> - %% Does not return but restarts process at - %% wakeup_from_hibernate/3 that jumps to loop_receive/3 - proc_lib:hibernate( - ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), - error( - {should_not_have_arrived_here_but_instead_in, - {wakeup_from_hibernate,3}}); - false -> - loop_receive(Parent, Debug, S) - end. +loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) -> + loop_hibernate(Parent, Debug, S); +loop(Parent, Debug, S) -> + loop_receive(Parent, Debug, S). + +loop_hibernate(Parent, Debug, S) -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive( - Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> +loop_receive(Parent, Debug, S) -> receive Msg -> case Msg of @@ -821,30 +854,87 @@ loop_receive( %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + Req, Pid, Parent, ?MODULE, Debug, S, + Hibernate); {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple and therefore - %% not an event and has no event_type(), - %% but this will stand out in the crash report... - terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, case TimerRefs of #{TimerRef := TimerType} -> - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of + #{TimerType := TimerRef} -> + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); + _ -> + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes), - Event); + Parent, Debug, S, Hibernate, Event) + end; + {cancel_timer,TimerRef,_} -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewCancelTimers = CancelTimers - 1, + NewS = + S#{ + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if + Hibernate =:= true, NewCancelTimers =:= 0 -> + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); + NewCancelTimers >= 0 -> % Assert + loop_receive(Parent, Debug, NewS) + end; _ -> + %% Not our cancel_timer msg; + %% present it as an event Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, Event) + Parent, Debug, S, Hibernate, Event) end; _ -> + %% External msg + #{hibernate := Hibernate} = S, Event = case Msg of {'$gen_call',From,Request} -> @@ -855,208 +945,212 @@ loop_receive( {info,Msg} end, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, Event) + Parent, Debug, S, Hibernate, Event) end end. loop_receive_result( - Parent, Debug, #{state := State} = S, - TimerRefs, TimerTypes, Event) -> - %% The fields 'timer_refs', 'timer_types' and 'hibernate' - %% are now invalid in state map S - they will be recalculated - %% and restored when we return to loop/3 - %% + Parent, Debug, + #{state := State, + timer_types := TimerTypes, cancel_timers := CancelTimers} = S, + Hibernate, Event) -> + %% From now the 'hibernate' field in S is invalid + %% and will be restored when looping back + %% in loop_event_result/11 NewDebug = sys_debug(Debug, S, State, {in,Event}), - %% Here the queue of not yet handled events is created + %% Here is the queue of not yet handled events created Events = [], - Hibernate = false, - loop_event( - Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). + %% Cancel any running event timer + case + cancel_timer_by_type(timeout, TimerTypes, CancelTimers) + of + {_,CancelTimers} -> + %% No timer cancelled + loop_event(Parent, NewDebug, S, Events, Event, Hibernate); + {NewTimerTypes,NewCancelTimers} -> + %% The timer is removed from NewTimerTypes but + %% remains in TimerRefs until we get + %% the cancel_timer msg + NewS = + S#{ + timer_types := NewTimerTypes, + cancel_timers := NewCancelTimers}, + loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate) + end. %% Entry point for handling an event, received or enqueued loop_event( - Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Parent, Debug, + #{state := State, data := Data} = S, Events, {Type,Content} = Event, Hibernate) -> %% - %% If Hibernate is true here it can only be + %% If (this old) Hibernate is true here it can only be %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user %% might rely on i.e collect garbage which %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), case call_state_function(S, Type, Content, State, Data) of {ok,Result,NewS} -> - %% Cancel event timeout - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type( - timeout, TimerRefs, TimerTypes), - {NewData,NextState,Actions} = + {NextState,NewData,Actions,EnterCall} = parse_event_result( - true, Debug, NewS, Result, - Events, Event, State, Data), + true, Debug, NewS, + Events, Event, State, Data, Result), loop_event_actions( - Parent, Debug, S, NewTimerRefs, NewTimerTypes, - Events, Event, NextState, NewData, Actions); + Parent, Debug, NewS, + Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) + Class, Reason, Stacktrace, Debug, S, + [Event|Events]) end. loop_event_actions( Parent, Debug, - #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, Actions) -> + #{state := State, state_enter := StateEnter} = S, + Events, Event, NextState, NewData, + Actions, EnterCall) -> + %% Hibernate is reborn here as false being + %% the default value from parse_actions/4 case parse_actions(Debug, S, State, Actions) of {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> if - StateEnter, NextState =/= State -> + StateEnter, EnterCall -> loop_event_enter( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR); - StateEnter -> - case maps:is_key(init_state, S) of - true -> - %% Avoid infinite loop in initial state - %% with state entry events - NewS = maps:remove(init_state, S), - loop_event_enter( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; true -> loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{data := NewData}, [Event|Events]) + Class, Reason, Stacktrace, Debug, S, + [Event|Events]) end. loop_event_enter( - Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Parent, Debug, #{state := State} = S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> - {NewerData,_,Actions} = - parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData), - loop_event_enter_actions( - Parent, Debug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewerData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + case parse_event_result( + false, Debug, NewS, + Events, Event, NextState, NewData, Result) of + {_,NewerData,Actions,EnterCall} -> + loop_event_enter_actions( + Parent, Debug, NewS, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) + end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + hibernate := Hibernate}, [Event|Events]) end. loop_event_enter_actions( - Parent, Debug, S, TimerRefs, TimerTypes, + Parent, Debug, #{state_enter := StateEnter} = S, Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) -> case parse_enter_actions( - Debug, S, NextState, Actions, - Hibernate, TimeoutsR) + Debug, S, NextState, Actions, Hibernate, TimeoutsR) of {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + if + StateEnter, EnterCall -> + loop_event_enter( + Parent, NewDebug, S, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + true -> + loop_event_result( + Parent, NewDebug, S, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR) + end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + hibernate := Hibernate}, [Event|Events]) end. loop_event_result( - Parent, Debug, - #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, - Events, Event, NextState, NewData, + Parent, Debug_0, + #{state := State, postponed := P_0, + timer_refs := TimerRefs_0, timer_types := TimerTypes_0, + cancel_timers := CancelTimers_0} = S_0, + Events_0, Event_0, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {NewDebug,P_1} = % Move current event to postponed if Postpone + {Debug_1,P_1} = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug, S, State, {postpone,Event,State}), - [Event|P_0]}; + {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), + [Event_0|P_0]}; false -> - {sys_debug(Debug, S, State, {consume,Event,State}), + {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), P_0} end, - {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = %% Move all postponed events to queue and cancel the %% state timeout if the state changes if NextState =:= State -> - {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; true -> - {lists:reverse(P_1, Events),[], + {lists:reverse(P_1, Events_0), + [], cancel_timer_by_type( - state_timeout, TimerRefs_0, TimerTypes_0)} + state_timeout, TimerTypes_0, CancelTimers_0)} + %% The state timer is removed from TimerTypes_1 + %% but remains in TimerRefs_0 until we get + %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,TimeoutEvents} = - %% Stop and start timers non-event timers - parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = + %% Stop and start non-event timers + parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), %% Place next events last in reversed queue Events_2R = lists:reverse(Events_1, NextEventsR), %% Enqueue immediate timeout events and start event timer - {NewTimerRefs,NewTimerTypes,Events_3R} = - process_timeout_events( - TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), - NewEvents = lists:reverse(Events_3R), - loop_events( - Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, - NewEvents, Hibernate, NextState, NewData, NewP). - -%% Loop until out of enqueued events -%% -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, - [] = _Events, Hibernate, State, Data, P) -> - %% Update S and loop back to loop/3 to receive a new event - NewS = - S#{ - state := State, - data := Data, - postponed := P, - hibernate => Hibernate, - timer_refs => TimerRefs, - timer_types => TimerTypes}, - loop(Parent, Debug, NewS); -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, - [Event|Events], Hibernate, State, Data, P) -> - %% Update S and continue with enqueued events - NewS = - S#{ - state := State, - data := Data, - postponed := P}, - loop_event( - Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). - + Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R), + S_1 = + S_0#{ + state := NextState, + data := NewData, + postponed := P_2, + timer_refs := TimerRefs_2, + timer_types := TimerTypes_2, + cancel_timers := CancelTimers_2, + hibernate := Hibernate}, + case lists:reverse(Events_3R) of + [] -> + %% Get a new event + loop(Parent, Debug_1, S_1); + [Event|Events] -> + %% Loop until out of enqueued events + loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + end. %%--------------------------------------------------------------------------- @@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) -> catch CallbackMode -> callback_mode_result(S, CallbackMode); - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,callback_mode,[]=Args,_} - |Stacktrace] -> - {error, - {undef_callback,{Module,callback_mode,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. @@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) -> call_state_function( - #{callback_mode := undefined} = S, - Type, Content, State, Data) -> + #{callback_mode := undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of {ok,NewS} -> call_state_function(NewS, Type, Content, State, Data); @@ -1135,13 +1215,12 @@ call_state_function( Error end; call_state_function( - #{callback_mode := CallbackMode, - module := Module} = S, + #{callback_mode := CallbackMode, module := Module} = S, Type, Content, State, Data) -> try case CallbackMode of state_functions -> - erlang:apply(Module, State, [Type,Content,Data]); + Module:State(Type, Content, Data); handle_event_function -> Module:handle_event(Type, Content, State, Data) end @@ -1151,41 +1230,6 @@ call_state_function( catch Result -> {ok,Result,S}; - error:badarg -> - case erlang:get_stacktrace() of - [{erlang,apply, - [Module,State,[Type,Content,Data]=Args], - _} - |Stacktrace] - when CallbackMode =:= state_functions -> - %% We get here e.g if apply fails - %% due to State not being an atom - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - Stacktrace -> - {error,badarg,Stacktrace} - end; - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,State,[Type,Content,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= state_functions -> - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - [{Module,handle_event,[Type,Content,State,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= handle_event_function -> - {error, - {undef_state_function,{Module,handle_event,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. @@ -1193,65 +1237,83 @@ call_state_function( %% Interpret all callback return variants parse_event_result( - AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> + AllowStateChange, Debug, S, + Events, Event, State, Data, Result) -> case Result of stop -> terminate( - exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, normal, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]); {stop,Reason,NewData} -> terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := NewData}, + [Event|Events]); + %% {stop_and_reply,Reason,Replies} -> - Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events], Replies); {stop_and_reply,Reason,Replies,NewData} -> - Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := NewData}, + [Event|Events], Replies); + %% {next_state,State,NewData} -> - {NewData,State,[]}; + {State,NewData,[],false}; {next_state,NextState,NewData} when AllowStateChange -> - {NewData,NextState,[]}; + {NextState,NewData,[],true}; {next_state,State,NewData,Actions} -> - {NewData,State,Actions}; + {State,NewData,Actions,false}; {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NewData,NextState,Actions}; + {NextState,NewData,Actions,true}; + %% {keep_state,NewData} -> - {NewData,State,[]}; + {State,NewData,[],false}; {keep_state,NewData,Actions} -> - {NewData,State,Actions}; + {State,NewData,Actions,false}; keep_state_and_data -> - {Data,State,[]}; + {State,Data,[],false}; {keep_state_and_data,Actions} -> - {Data,State,Actions}; + {State,Data,Actions,false}; + %% + {repeat_state,NewData} -> + {State,NewData,[],true}; + {repeat_state,NewData,Actions} -> + {State,NewData,Actions,true}; + repeat_state_and_data -> + {State,Data,[],true}; + {repeat_state_and_data,Actions} -> + {State,Data,Actions,true}; + %% _ -> terminate( error, {bad_return_from_state_function,Result}, - ?STACKTRACE(), - Debug, S, [Event|Events]) + ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]) end. -parse_enter_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR) -> +parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> Postpone = forbidden, NextEventsR = forbidden, parse_actions( Debug, S, State, listify(Actions), Hibernate, TimeoutsR, Postpone, NextEventsR). - + parse_actions(Debug, S, State, Actions) -> Hibernate = false, - TimeoutsR = [], + TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer Postpone = false, NextEventsR = [], parse_actions( @@ -1279,64 +1341,29 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; + %% %% Actions that set options {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, NewHibernate, TimeoutsR, Postpone, NextEventsR); - {hibernate,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; hibernate -> + NewHibernate = true, parse_actions( Debug, S, State, Actions, - true, TimeoutsR, Postpone, NextEventsR); - {state_timeout,Time,_} = StateTimeout - when is_integer(Time), Time >= 0; - Time =:= infinity -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); - {state_timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - {timeout,infinity,_} -> - %% Ignore - timeout will never happen and already cancelled - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); - {timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - infinity -> % Ignore - timeout will never happen - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - Time when is_integer(Time), Time >= 0 -> - Timeout = {timeout,Time,Time}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + NewHibernate, TimeoutsR, Postpone, NextEventsR); + %% {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, Hibernate, TimeoutsR, NewPostpone, NextEventsR); - {postpone,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; postpone when Postpone =/= forbidden -> + NewPostpone = true, parse_actions( Debug, S, State, Actions, - Hibernate, TimeoutsR, true, NextEventsR); + Hibernate, TimeoutsR, NewPostpone, NextEventsR); + %% {next_event,Type,Content} -> case event_type(Type) of true when NextEventsR =/= forbidden -> @@ -1351,96 +1378,150 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; - _ -> + %% + {state_timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + Time -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Time) + end. + +parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> + Time = + case Timeout of + {_,T,_} -> T; + T -> T + end, + case validate_time(Time) of + true -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + false -> {error, - {bad_action_from_state_function,Action}, + {bad_action_from_state_function,Timeout}, ?STACKTRACE()} end. +validate_time(Time) when is_integer(Time), Time >= 0 -> true; +validate_time(infinity) -> true; +validate_time(_) -> false. %% Stop and start timers as well as create timeout zero events %% and pending event timer %% %% Stop and start timers non-event timers -parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). %% -parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> - {TimerType,Time,TimerMsg} = Timeout, + TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], + Seen, TimeoutEvents) -> + case Timeout of + {TimerType,Time,TimerMsg} -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg); + Time -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + timeout, Time, Time) + end. + +parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, - %% Cancel any running timer - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), - if - Time =:= infinity -> - %% Ignore - timer will never fire + case Time of + infinity -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); - TimerType =:= timeout -> - %% Handle event timer later - parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, - NewSeen, [Timeout|TimeoutEvents]); - Time =:= 0 -> + 0 -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); - true -> - %% Start a new timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - parse_timers( - NewTimerRefs#{TimerRef => TimerType}, - NewTimerTypes#{TimerType => TimerRef}, - TimeoutsR, NewSeen, TimeoutEvents) + _ -> + %% (Re)start the timer + TimerRef = + erlang:start_timer(Time, self(), TimerMsg), + case TimerTypes of + #{TimerType := OldTimerRef} -> + %% Cancel the running timer + cancel_timer(OldTimerRef), + NewCancelTimers = CancelTimers + 1, + %% Insert the new timer into + %% both TimerRefs and TimerTypes + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + NewCancelTimers, TimeoutsR, + NewSeen, TimeoutEvents); + #{} -> + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + CancelTimers, TimeoutsR, + NewSeen, TimeoutEvents) + end end end. -%% Enqueue immediate timeout events and start event timer -process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> - {TimerRefs, TimerTypes, EventsR}; -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,0,TimerMsg}|TimeoutEvents], []) -> - %% No enqueued events - insert a timeout zero event - TimeoutEvent = {timeout,TimerMsg}, - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent]); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,Time,TimerMsg}], []) -> - %% No enqueued events - start event timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - process_timeout_events( - TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, - [], []); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> - %% There will be some other event so optimize by not starting - %% an event timer to just have to cancel it again - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, EventsR); -process_timeout_events( - TimerRefs, TimerTypes, - [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent|EventsR]). +%% Enqueue immediate timeout events (timeout 0 events) +%% +%% Event timer timeout 0 events gets special treatment since +%% an event timer is cancelled by any received event, +%% so if there are enqueued events before the event timer +%% timeout 0 event - the event timer is cancelled hence no event. +%% +%% Other (state_timeout) timeout 0 events that are after +%% the event timer timeout 0 events are considered to +%% belong to timers that were started after the event timer +%% timeout 0 event fired, so they do not cancel the event timer. +%% +prepend_timeout_events([], EventsR) -> + EventsR; +prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> + prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); +prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + prepend_timeout_events(TimeoutEvents, EventsR); +prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> + %% Just prepend all others + prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]). @@ -1448,18 +1529,11 @@ process_timeout_events( %% Server helpers reply_then_terminate( - Class, Reason, Stacktrace, - Debug, #{state := State} = S, Q, Replies) -> - if - is_list(Replies) -> - do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, Replies, State); - true -> - do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, [Replies], State) - end. + Class, Reason, Stacktrace, Debug, + #{state := State} = S, Q, Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, + S, Q, listify(Replies), State). %% do_reply_then_terminate( Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> @@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) -> terminate( - Class, Reason, Stacktrace, - Debug, + Class, Reason, Stacktrace, Debug, #{module := Module, state := State, data := Data, postponed := P} = S, Q) -> - try Module:terminate(Reason, State, Data) of - _ -> ok - catch - _ -> ok; - C:R -> - ST = erlang:get_stacktrace(), - error_info( - C, R, ST, S, Q, P, - format_status(terminate, get(), S)), - sys:print_log(Debug), - erlang:raise(C, R, ST) + case erlang:function_exported(Module, terminate, 3) of + true -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), + erlang:raise(C, R, ST) + end; + false -> + ok end, _ = case Reason of @@ -1637,28 +1715,21 @@ listify(Item) -> [Item]. %% Cancel timer if running, otherwise no op -cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> +%% +%% This is an asynchronous cancel so the timer is not really cancelled +%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}. +%% In the mean time we might get a timeout message. +%% +%% Remove the timer from TimerTypes. +%% When we get the cancel_timer msg we remove it from TimerRefs. +cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> case TimerTypes of #{TimerType := TimerRef} -> cancel_timer(TimerRef), - {maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes)}; + {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerRefs,TimerTypes} + {TimerTypes,CancelTimers} end. -%%cancel_timer(undefined) -> -%% ok; -cancel_timer(TRef) -> - case erlang:cancel_timer(TRef) of - false -> - %% We have to assume that TRef is the ref of a running timer - %% and if so the timer has expired - %% hence we must wait for the timeout message - receive - {timeout,TRef,_} -> - ok - end; - _TimeLeft -> - ok - end. +cancel_timer(TimerRef) -> + ok = erlang:cancel_timer(TimerRef, [{async,true}]). diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 16ca2f41dc..ba2cffdcb3 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -128,6 +128,10 @@ max_cs(M, _Len) -> M. -define(ATM(T), is_list(element(1, T))). +-define(ATM_PAIR(Pair), + ?ATM(element(2, element(1, Pair))) % Key + andalso + ?ATM(element(3, element(1, Pair)))). % Value -define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))). pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W) @@ -140,9 +144,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}]; pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> - [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}]; -pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> - [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)]; + [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1), + $}]; pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> [Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}]; pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) -> @@ -166,6 +169,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) -> [Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)] end. +pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; +pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + "..."; +pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) -> + {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W), + [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)]. + +pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; +pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> + ",..."; +pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) -> + LD1 = last_depth(Ps, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) -> + [$,, write_pair(P) | + pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)]; + true -> + {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0), + [$,, $\n, Ind, PS | + pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)] + end. + +pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + {write_pair(Pair), if + ?ATM_PAIR(Pair) -> + Len; + true -> + Ll % force nl + end}; +pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) -> + I = map_value_indent(TInd), + Ind = indent(I, Ind0), + {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n", + Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl + pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> ""; pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> @@ -204,7 +247,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W) end}; pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) -> {Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL), - {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl + Sep = case S of + [$\n | _] -> " ="; + _ -> " = " + end, + {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl rec_indent(RInd, TInd, Col0, Ind0, W0) -> Nl = (TInd > 0) and (RInd > TInd), @@ -291,8 +338,8 @@ write({{list, L}, _}) -> [$[, write_list(L, $|), $]]; write({{map, Pairs}, _}) -> [$#,${, write_list(Pairs, $,), $}]; -write({{map_pair, K, V}, _}) -> - [write(K)," => ",write(V)]; +write({{map_pair, _K, _V}, _}=Pair) -> + write_pair(Pair); write({{record, [{Name,_} | L]}, _}) -> [Name, ${, write_fields(L), $}]; write({{bin, S}, _}) -> @@ -300,6 +347,9 @@ write({{bin, S}, _}) -> write({S, _}) -> S. +write_pair({{map_pair, K, V}, _}) -> + [write(K), " => ", write(V)]. + write_fields([]) -> ""; write_fields({dots, _}) -> @@ -333,7 +383,7 @@ write_tail(E, S) -> %% The depth (D) is used for extracting and counting the characters to %% print. The structure is kept so that the returned intermediate -%% format can be formatted. The separators (list, tuple, record) are +%% format can be formatted. The separators (list, tuple, record, map) are %% counted but need to be added later. %% D =/= 0 @@ -406,21 +456,32 @@ print_length(Term, _D, _RF, _Enc, _Str) -> print_length_map(_Map, 1, _RF, _Enc, _Str) -> {"#{...}", 6}; print_length_map(Map, D, RF, Enc, Str) when is_map(Map) -> - Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str), + Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str), {{map, Pairs}, list_length(Pairs, 3)}. +maps_to_list(Map, D) when D < 0; map_size(Map) =< D -> + maps:to_list(Map); +maps_to_list(Map, D) -> + F = fun(_K, _V, {N, L}) when N =:= D -> + throw(L); + (K, V, {N, L}) -> + {N+1, [{K, V} | L]} + end, + lists:reverse(catch maps:fold(F, {0, []}, Map)). + print_length_map_pairs([], _D, _RF, _Enc, _Str) -> []; print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) -> - [print_length_map_pair(K,V,D-1,RF,Enc,Str) | - print_length_map_pairs(Pairs,D-1,RF,Enc,Str)]. +print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) -> + [print_length_map_pair(K, V, D - 1, RF, Enc, Str) | + print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)]. print_length_map_pair(K, V, D, RF, Enc, Str) -> {KS, KL} = print_length(K, D, RF, Enc, Str), {VS, VL} = print_length(V, D, RF, Enc, Str), - {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}. + KL1 = KL + 4, + {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}. print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; @@ -612,6 +673,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) -> cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1); cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) -> cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1); +cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) -> + cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2); cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) -> cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1); cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) -> @@ -637,6 +700,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) -> throw(no_good) end. +cind_map([P | Ps], Col, Ll, M, Ind, LD, W) -> + PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W), + cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW); +cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) -> + LD1 = last_depth(Ps, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) -> + cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen); + true -> + PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0), + cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW) + end; +cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + if + ?ATM_PAIR(Pair) -> + Len; + true -> + Ll + end; +cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) -> + cind(K, Col0, Ll, M, Ind, LD, W0), + I = map_value_indent(Ind), + cind(V, Col0 + I, Ll, M, Ind, LD, 0), + Ll. + +map_value_indent(TInd) -> + case TInd > 0 of + true -> + TInd; + false -> + 4 + end. + cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) -> Nind = Nlen + 1, {Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0), diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f3665824f2..8c4d835432 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% Copyright Ericsson AB 2004-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> end; abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) -> {special, Line, lists:flatten(io_lib:write(PPR))}; +abstr_term(Map, Line) when is_map(Map) -> + {map,Line, + [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} || + {K,V} <- maps:to_list(Map)]}; abstr_term(Simple, Line) -> erl_parse:abstract(Simple, erl_anno:line(Line)). diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index 340cc21390..fadf96146e 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -179,19 +179,6 @@ external_attr, local_header_offset}). -%% Unix extra fields (not yet supported) --define(UNIX_EXTRA_FIELD_TAG, 16#000d). --record(unix_extra_field, {atime, - mtime, - uid, - gid}). - -%% extended timestamps (not yet supported) --define(EXTENDED_TIMESTAMP_TAG, 16#5455). -%% -record(extended_timestamp, {mtime, -%% atime, -%% ctime}). - -define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50). -define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)). @@ -381,9 +368,12 @@ do_unzip(F, Options) -> {Info, In1} = get_central_dir(In0, RawIterator, Input), %% get rid of zip-comment Z = zlib:open(), - Files = get_z_files(Info, Z, In1, Opts, []), - zlib:close(Z), - Input(close, In1), + Files = try + get_z_files(Info, Z, In1, Opts, []) + after + zlib:close(Z), + Input(close, In1) + end, {ok, Files}. %% Iterate over all files in a zip archive @@ -460,11 +450,20 @@ do_zip(F, Files, Options) -> #zip_opts{output = Output, open_opts = OpO} = Opts, Out0 = Output({open, F, OpO}, []), Z = zlib:open(), - {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []), - zlib:close(Z), - Out2 = put_central_dir(LHS, Pos, Out1, Opts), - Out3 = Output({close, F}, Out2), - {ok, Out3}. + try + {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []), + zlib:close(Z), + Out2 = put_central_dir(LHS, Pos, Out1, Opts), + Out3 = Output({close, F}, Out2), + {ok, Out3} + catch + C:R -> + Stk = erlang:get_stacktrace(), + zlib:close(Z), + Output({close, F}, Out0), + erlang:raise(C, R, Stk) + end. + %% List zip directory contents %% @@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName, gid = 0}, add_extra_info(FI, ExtraField). -%% add extra info to file (some day when we implement it) -add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) -> - FI; % not yet supported, some other day... -add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) -> - _UnixExtra = unix_extra_field_and_var_from_bin(Rest), - FI; % not yet supported, and not widely used +%% Currently, we ignore all the extra fields. add_extra_info(FI, _) -> FI. @@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) -> <<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>, {DosDate, DosTime}. -unix_extra_field_and_var_from_bin(<<TSize:16/little, - ATime:32/little, - MTime:32/little, - UID:16/little, - GID:16/little, - Var:TSize/binary>>) -> - {#unix_extra_field{atime = ATime, - mtime = MTime, - uid = UID, - gid = GID}, - Var}; -unix_extra_field_and_var_from_bin(_) -> - throw(bad_unix_extra_field). - %% A pwrite-like function for iolists (used by memory-option) pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos -> diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 718d91c6a3..1f694ea549 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2, init_per_group/2,end_per_group/2]). --export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]). +-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1, + erl_352/1]). -include_lib("common_test/include/ct.hrl"). @@ -36,7 +37,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [normal, quoted_fun, quoted_module, quoted_both, erl_1152]. + [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352]. groups() -> []. @@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) -> "\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]), ok. +erl_352(Config) when is_list(Config) -> + erl_352_test(3, 3), + + erl_352_test(3, 75), + erl_352_test(3, 76, [trailing]), + erl_352_test(4, 74), + erl_352_test(4, 75, [leading]), + erl_352_test(4, 76, [leading, trailing]), + + erl_352_test(75, 3), + erl_352_test(76, 3, [leading]), + erl_352_test(74, 4), + erl_352_test(75, 4, [leading]), + erl_352_test(76, 4, [leading]), + + erl_352_test(74, 74, [leading]), + erl_352_test(74, 75, [leading]), + erl_352_test(74, 76, [leading, trailing]). + +erl_352_test(PrefixLen, SuffixLen) -> + erl_352_test(PrefixLen, SuffixLen, []). + +erl_352_test(PrefixLen, SuffixLen, Dots) -> + io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]), + + PrefixM = lists:duplicate(PrefixLen, $p), + SuffixM = lists:duplicate(SuffixLen, $s), + LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]], + StrM = do_format(LM), + check_leading(StrM, "", PrefixM, SuffixM, Dots), + + PrefixF = lists:duplicate(PrefixLen, $p), + SuffixF = lists:duplicate(SuffixLen-2, $s), + LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]], + StrF = do_format(LF), + true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots), + + ok. + +check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) -> + List = string:tokens(FormStr, "\n "), + io:format("~p\n", [List]), + true = lists:all(fun(L) -> length(L) < 80 end, List), + case lists:member(leading, Dots) of + true -> + true = lists:all(fun(L) -> + {"...", Rest} = lists:split(3, L), + check_trailing(Rest, ArityStr, + Suffix, Dots) + end, List); + false -> + true = lists:all(fun(L) -> + {Prefix, Rest} = + lists:split(length(Prefix), L), + check_trailing(Rest, ArityStr, + Suffix, Dots) + end, List) + end. + +check_trailing([I|Str], ArityStr, Suffix, Dots) -> + true = lists:member(I, [$1, $2]), + case lists:member(trailing, Dots) of + true -> + {Rest, "..." ++ ArityStr} = + lists:split(length(Str) - (3 + length(ArityStr)), Str), + true = lists:prefix(Rest, Suffix); + false -> + {Rest, ArityStr} = + lists:split(length(Str) - length(ArityStr), Str), + Rest =:= Suffix + end. + do_expand(String) -> edlin_expand:expand(lists:reverse(String)). diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 28d69232a0..0b9106a99c 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -28,6 +28,7 @@ strange_name/1, emulator_flags/1, emulator_flags_no_shebang/1, + two_lines/1, module_script/1, beam_script/1, archive_script/1, @@ -49,7 +50,7 @@ suite() -> all() -> [basic, errors, strange_name, emulator_flags, - emulator_flags_no_shebang, + emulator_flags_no_shebang, two_lines, module_script, beam_script, archive_script, epp, create_and_extract, foldl, overflow, archive_script_file_access, unicode]. @@ -153,6 +154,18 @@ emulator_flags(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +two_lines(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + Dir = filename:absname(Data), %Get rid of trailing slash. + run(Dir, "two_lines -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + "ERL_FLAGS=false\n" + "unknown:[]\n" + "ExitCode:0">>]), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + emulator_flags_no_shebang(Config) when is_list(Config) -> Data = proplists:get_value(data_dir, Config), Dir = filename:absname(Data), %Get rid of trailing slash. diff --git a/lib/stdlib/test/escript_SUITE_data/two_lines b/lib/stdlib/test/escript_SUITE_data/two_lines new file mode 100755 index 0000000000..cf4e99639c --- /dev/null +++ b/lib/stdlib/test/escript_SUITE_data/two_lines @@ -0,0 +1,2 @@ +#! /usr/bin/env escript +main(MainArgs) -> io:format("main:~p\n", [MainArgs]), ErlArgs = init:get_arguments(), io:format("ERL_FLAGS=~p\n", [os:getenv("ERL_FLAGS")]), io:format("unknown:~p\n",[[E || E <- ErlArgs, element(1, E) =:= unknown]]). diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index b7c4d3a6e5..f64ec6acb7 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -29,6 +29,7 @@ dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]). -export([pathtype_bin/1,rootname_bin/1,split_bin/1]). -export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]). +-export([safe_relative_path/1]). -include_lib("common_test/include/ct.hrl"). @@ -41,7 +42,8 @@ all() -> find_src, absname_bin, absname_bin_2, {group,p}, - t_basedir_xdg, t_basedir_windows]. + t_basedir_xdg, t_basedir_windows, + safe_relative_path]. groups() -> [{p, [parallel], @@ -768,6 +770,71 @@ t_nativename_bin(Config) when is_list(Config) -> filename:nativename(<<"/usr/tmp//arne/">>) end. +safe_relative_path(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Root = filename:join(PrivDir, ?FUNCTION_NAME), + ok = file:make_dir(Root), + ok = file:set_cwd(Root), + + ok = file:make_dir("a"), + ok = file:set_cwd("a"), + ok = file:make_dir("b"), + ok = file:set_cwd("b"), + ok = file:make_dir("c"), + + ok = file:set_cwd(Root), + + "a" = test_srp("a"), + "a/b" = test_srp("a/b"), + "a/b" = test_srp("a/./b"), + "a/b" = test_srp("a/./b/."), + + "" = test_srp("a/.."), + "" = test_srp("a/./.."), + "" = test_srp("a/../."), + "a" = test_srp("a/b/.."), + "a" = test_srp("a/../a"), + "a" = test_srp("a/../a/../a"), + "a/b/c" = test_srp("a/../a/b/c"), + + unsafe = test_srp("a/../.."), + unsafe = test_srp("a/../../.."), + unsafe = test_srp("a/./../.."), + unsafe = test_srp("a/././../../.."), + unsafe = test_srp("a/b/././../../.."), + + unsafe = test_srp(PrivDir), %Absolute path. + + ok. + +test_srp(RelPath) -> + Res = do_test_srp(RelPath), + Res = case do_test_srp(list_to_binary(RelPath)) of + Bin when is_binary(Bin) -> + binary_to_list(Bin); + Other -> + Other + end. + +do_test_srp(RelPath) -> + {ok,Root} = file:get_cwd(), + ok = file:set_cwd(RelPath), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Root), + case filename:safe_relative_path(RelPath) of + unsafe -> + true = length(Cwd) < length(Root), + unsafe; + "" -> + ""; + SafeRelPath -> + ok = file:set_cwd(SafeRelPath), + {ok,Cwd} = file:get_cwd(), + true = length(Cwd) >= length(Root), + ok = file:set_cwd(Root), + SafeRelPath + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% basedirs t_basedir_api(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 119546be98..24f0864b3c 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -38,7 +38,7 @@ all() -> {group, abnormal}, {group, abnormal_handle_event}, shutdown, stop_and_reply, state_enter, event_order, - state_timeout, code_change, + state_timeout, event_types, code_change, {group, sys}, hibernate, enter_loop]. @@ -600,15 +600,26 @@ state_enter(_Config) -> (internal, Prev, N) -> Self ! {internal,start,Prev,N}, {keep_state,N + 1}; + ({call,From}, repeat, N) -> + {repeat_state,N + 1, + [{reply,From,{repeat,start,N}}]}; ({call,From}, echo, N) -> - {next_state,wait,N + 1,{reply,From,{echo,start,N}}}; + {next_state,wait,N + 1, + {reply,From,{echo,start,N}}}; ({call,From}, {stop,Reason}, N) -> - {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1} + {stop_and_reply,Reason, + [{reply,From,{stop,N}}],N + 1} end, wait => - fun (enter, Prev, N) -> + fun (enter, Prev, N) when N < 5 -> + {repeat_state,N + 1, + {reply,{Self,N},{enter,Prev}}}; + (enter, Prev, N) -> Self ! {enter,wait,Prev,N}, {keep_state,N + 1}; + ({call,From}, repeat, N) -> + {repeat_state_and_data, + [{reply,From,{repeat,wait,N}}]}; ({call,From}, echo, N) -> {next_state,start,N + 1, [{next_event,internal,wait}, @@ -620,11 +631,15 @@ state_enter(_Config) -> [{enter,start,start,1}] = flush(), {echo,start,2} = gen_statem:call(STM, echo), - [{enter,wait,start,3}] = flush(), - {wait,[4|_]} = sys:get_state(STM), - {echo,wait,4} = gen_statem:call(STM, echo), - [{enter,start,wait,5},{internal,start,wait,6}] = flush(), - {stop,7} = gen_statem:call(STM, {stop,bye}), + [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(), + {wait,[6|_]} = sys:get_state(STM), + {repeat,wait,6} = gen_statem:call(STM, repeat), + [{enter,wait,wait,6}] = flush(), + {echo,wait,7} = gen_statem:call(STM, echo), + [{enter,start,wait,8},{internal,start,wait,9}] = flush(), + {repeat,start,10} = gen_statem:call(STM, repeat), + [{enter,start,start,11}] = flush(), + {stop,12} = gen_statem:call(STM, {stop,bye}), [{'EXIT',STM,bye}] = flush(), {noproc,_} = @@ -801,6 +816,74 @@ state_timeout(_Config) -> +%% Test that all event types can be sent with {next_event,EventType,_} +event_types(_Config) -> + process_flag(trap_exit, true), + + Machine = + %% Abusing the internal format of From... + #{init => + fun () -> + {ok, start, undefined} + end, + start => + fun ({call,_} = Call, Req, undefined) -> + {next_state, state1, undefined, + [{next_event,internal,1}, + {next_event,state_timeout,2}, + {next_event,timeout,3}, + {next_event,info,4}, + {next_event,cast,5}, + {next_event,Call,Req}]} + end, + state1 => + fun (internal, 1, undefined) -> + {next_state, state2, undefined} + end, + state2 => + fun (state_timeout, 2, undefined) -> + {next_state, state3, undefined} + end, + state3 => + fun (timeout, 3, undefined) -> + {next_state, state4, undefined} + end, + state4 => + fun (info, 4, undefined) -> + {next_state, state5, undefined} + end, + state5 => + fun (cast, 5, undefined) -> + {next_state, state6, undefined} + end, + state6 => + fun ({call,From}, stop, undefined) -> + {stop_and_reply, shutdown, + [{reply,From,stopped}]} + end}, + {ok,STM} = + gen_statem:start_link( + ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]), + + stopped = gen_statem:call(STM, stop), + receive + {'EXIT',STM,shutdown} -> + ok + after 500 -> + ct:fail(did_not_stop) + end, + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason), + case flush() of + [] -> + ok; + Other2 -> + ct:fail({unexpected,Other2}) + end. + + + sys1(Config) -> {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), {status, Pid, {module,gen_statem}, _} = sys:get_status(Pid), @@ -1722,6 +1805,10 @@ handle_event( {keep_state,[NewData|Machine]}; {keep_state,NewData,Ops} -> {keep_state,[NewData|Machine],Ops}; + {repeat_state,NewData} -> + {repeat_state,[NewData|Machine]}; + {repeat_state,NewData,Ops} -> + {repeat_state,[NewData|Machine],Ops}; Other -> Other end; diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 7d48cbc97c..6e99619324 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,7 +30,7 @@ io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, otp_10836/1, io_lib_width_too_small/1, io_with_huge_message_queue/1, format_string/1, - maps/1, coverage/1]). + maps/1, coverage/1, otp_14175/1]). -export([pretty/2]). @@ -61,7 +61,7 @@ all() -> printable_range, bad_printable_range, io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, io_lib_width_too_small, io_with_huge_message_queue, - format_string, maps, coverage]. + format_string, maps, coverage, otp_14175]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) -> bt(<<"#rrrrr{\n" " f1 = 1,\n" " f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n" - " f3 = \n" + " f3 =\n" " #rrrrr{\n" " f1 = h,f2 = i,\n" - " f3 = \n" + " f3 =\n" " #rrrrr{\n" " f1 = aa,\n" - " f2 = \n" + " f2 =\n" " #rrrrr{\n" " f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n" " f2 = 2,f3 = 3},\n" @@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) -> 2,3},bb}}}, -1)), bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n" - " bbbbbbbbbbbbbbbbbbbb = \n" + " bbbbbbbbbbbbbbbbbbbb =\n" " #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n" " cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n" " eeeeeeeeeeeeeeeeeeee = e},\n" " cccccccccccccccccccc = 3,\n" - " dddddddddddddddddddd = \n" + " dddddddddddddddddddd =\n" " #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n" - " cccccccccccccccccccc = \n" + " cccccccccccccccccccc =\n" " #d{aaaaaaaaaaaaaaaaaaaa = aa," "bbbbbbbbbbbbbbbbbbbb = bb,\n" - " cccccccccccccccccccc = \n" + " cccccccccccccccccccc =\n" " #d{aaaaaaaaaaaaaaaaaaaa = 1," "bbbbbbbbbbbbbbbbbbbb = 2,\n" " cccccccccccccccccccc = 3," @@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) -> p({A,{A,{A,{A,{A,{A,{A, {g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)), bt(<<"#c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" - " f1 = \n" + " f1 =\n" " #c{\n" " f1 = #c{f1 = #c{f1 = #c{f1 = a," "f2 = b},f2 = b},f2 = b},\n" @@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) -> p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b}, b},b},b},b},b},b}, -1)), bt(<<"#rrrrr{\n" - " f1 = \n" + " f1 =\n" " #rrrrr{\n" - " f1 = \n" + " f1 =\n" " #rrrrr{\n" - " f1 = \n" + " f1 =\n" " #rrrrr{\n" - " f1 = \n" + " f1 =\n" " {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a," "f3 = b}},b},\n" " f2 = {rrrrr,c,d},\n" @@ -2106,3 +2106,200 @@ coverage(_Config) -> io:format("~s\n", [S2]), ok. + +otp_14175(_Config) -> + "..." = p(#{}, 0), + "#{}" = p(#{}, 1), + "#{...}" = p(#{a => 1}, 1), + "#{#{} => a}" = p(#{#{} => a}, 2), + "#{a => 1,...}" = p(#{a => 1, b => 2}, 2), + "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1), + + M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2, + kccccccccccccccccccc => v3,kddddddddddddddddddd => v4, + keeeeeeeeeeeeeeeeeee => v5}, + "#{...}" = p(M, 1), + mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)), + mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}", + p(M, 3)), + + mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n" + " kccccccccccccccccccc => v3,...}", p(M, 4)), + + mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n" + " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}", + p(M, 5)), + + mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n" + " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n" + " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)), + + weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n" + " cccccccccccccccccccc => {3},\n" + " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}", + p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2, + cccccccccccccccccccc => {3}, + dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)), + + M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2, + {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4, + {eeeeeeeeeeeeeeeeeeee} => 5}, + "#{...}" = p(M2, 1), + weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)), + weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)), + + weak("#{dddddddddddddddddddd => {1},\n" + " {aaaaaaaaaaaaaaaaaaaa} => 2,\n" + " {...} => 3,...}", p(M2, 4)), + + weak("#{dddddddddddddddddddd => {1},\n" + " {aaaaaaaaaaaaaaaaaaaa} => 2,\n" + " {bbbbbbbbbbbbbbbbbbbb} => 3,\n" + " {...} => 4,...}", p(M2, 5)), + + weak("#{dddddddddddddddddddd => {1},\n" + " {aaaaaaaaaaaaaaaaaaaa} => 2,\n" + " {bbbbbbbbbbbbbbbbbbbb} => 3,\n" + " {cccccccccccccccccccc} => 4,\n" + " {...} => 5}", p(M2, 6)), + + weak("#{dddddddddddddddddddd => {1},\n" + " {aaaaaaaaaaaaaaaaaaaa} => 2,\n" + " {bbbbbbbbbbbbbbbbbbbb} => 3,\n" + " {cccccccccccccccccccc} => 4,\n" + " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)), + + M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu, + kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv, + kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, + kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, + keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}, + + mt("#{aaaaaaaaaaaaaaaaaaaa =>\n" + " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n" + " bbbbbbbbbbbbbbbbbbbb =>\n" + " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n" + " cccccccccccccccccccc =>\n" + " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n" + " dddddddddddddddddddd =>\n" + " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n" + " eeeeeeeeeeeeeeeeeeee =>\n" + " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)), + + R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b}, + b},b},b},b},b},b}, + M4 = #{aaaaaaaaaaaaaaaaaaaa => R4, + bbbbbbbbbbbbbbbbbbbb => R4, + cccccccccccccccccccc => R4, + dddddddddddddddddddd => R4, + eeeeeeeeeeeeeeeeeeee => R4}, + + weak("#{aaaaaaaaaaaaaaaaaaaa =>\n" + " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n" + " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n" + " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n" + " dddddddddddddddddddd => #c{f1 = {...},...},\n" + " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)), + + M5 = #{aaaaaaaaaaaaaaaaaaaa => R4}, + mt("#{aaaaaaaaaaaaaaaaaaaa =>\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 =\n" + " #c{\n" + " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b}," + "f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b},\n" + " f2 = b}}", p(M5, -1)), + ok. + +%% Just check number of newlines and dots ('...'). +-define(WEAK, true). + +-ifdef(WEAK). + +weak(S, R) -> + (nl(S) =:= nl(R) andalso + dots(S) =:= dots(S)). + +nl(S) -> + [C || C <- S, C =:= $\n]. + +dots(S) -> + [C || C <- S, C =:= $\.]. + +-else. % WEAK + +weak(S, R) -> + mt(S, R). + +-endif. % WEAK + +%% If EXACT is defined: mt() matches strings exactly. +%% +%% if EXACT is not defined: do not match the strings exactly, but +%% compare them assuming that all map keys and all map values are +%% equal (by assuming all map keys and all map values have the same +%% length and begin with $k and $v respectively). + +%-define(EXACT, true). + +-ifdef(EXACT). + +mt(S, R) -> + S =:= R. + +-else. % EXACT + +mt(S, R) -> + anon(S) =:= anon(R). + +anon(S) -> + {ok, Ts0, _} = erl_scan:string(S, 1, [text]), + Ts = anon1(Ts0), + text(Ts). + +anon1([]) -> []; +anon1([{atom,Anno,Atom}=T|Ts]) -> + case erl_anno:text(Anno) of + "k" ++ _ -> + NewAnno = erl_anno:set_text("key", Anno), + [{atom,NewAnno,Atom}|anon1(Ts)]; + "v" ++ _ -> + NewAnno = erl_anno:set_text("val", Anno), + [{atom,NewAnno,Atom}|anon1(Ts)]; + _ -> + [T|anon1(Ts)] + end; +anon1([T|Ts]) -> + [T|anon1(Ts)]. + +text(Ts) -> + lists:append(text1(Ts)). + +text1([]) -> []; +text1([T|Ts]) -> + Anno = element(2, T), + [erl_anno:text(Anno) | text1(Ts)]. + +-endif. % EXACT diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 2bd940020c..846c2c56f4 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% Copyright Ericsson AB 2004-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -869,11 +869,12 @@ eval_unique(Config) when is_list(Config) -> [a] = qlc:e(Q2, {unique_all, true}) ">>, - <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)], + <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]], + unique)], unique), {call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} = qlc:info(Q, [{format,abstract_code},unique_all]), - [1,2] = qlc:e(Q)">>, + [1,2,#{a := 1}] = qlc:e(Q)">>, <<"Q = qlc:q([X || X <- [1,2,1]]), {call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} = @@ -2620,7 +2621,16 @@ info(Config) when is_list(Config) -> {cons, _, _, _}]}, {nil,_}}]}]} = i(QH, {format, abstract_code}), [{5},{6}] = qlc:e(QH), - [{4},{5},{6}] = qlc:e(F(3))">> + [{4},{5},{6}] = qlc:e(F(3))">>, + + <<"Fun = fun ?MODULE:i/2, + L = [{#{k => #{v => Fun}}, Fun}], + H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]), + L = qlc:e(H), + {call,_,_,[{lc,_,{var,_,'Q'}, + [{generate,_,_,_}, + {op,_,_,_,_}]}]} = + qlc:info(H, [{format,abstract_code}])">> ], run(Config, Ts), diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 02b7cb10c2..47e7c4f03d 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -275,13 +275,13 @@ gen(_, _, Acc) -> lists:reverse(Acc). %% Check that the algorithms generate sound values. basic_stats_uniform_1(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_uniform_2(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) || Alg <- algs()], ok. @@ -388,7 +388,7 @@ crypto_uniform_n(N, State0) -> %% Not a test but measures the time characteristics of the different algorithms measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time Algos = [crypto64|algs()], io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index c409a6949b..80585ca359 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2325,7 +2325,7 @@ otp_6554(Config) when is_list(Config) -> "[unproper | list]).">>), %% Cheating: "exception error: no function clause matching " - "erl_eval:do_apply(4)" ++ _ = + "shell:apply_fun(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), "exception error: no function clause matching " "lists:reverse(" ++ _ = diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 7d90795c9e..f0feda217a 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -27,7 +27,7 @@ openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1, unzip_traversal_exploit/1, compress_control/1, - foldl/1]). + foldl/1,fd_leak/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -40,7 +40,7 @@ all() -> unzip_to_binary, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, zip_api, open_leak, unzip_jar, compress_control, foldl, - unzip_traversal_exploit]. + unzip_traversal_exploit,fd_leak]. groups() -> []. @@ -882,3 +882,35 @@ foldl(Config) -> {error, enoent} = zip:foldl(ZipFun, [], File), ok. + +fd_leak(Config) -> + ok = file:set_cwd(proplists:get_value(priv_dir, Config)), + DataDir = proplists:get_value(data_dir, Config), + Name = filename:join(DataDir, "bad_file_header.zip"), + BadExtract = fun() -> + {error,bad_file_header} = zip:extract(Name), + ok + end, + do_fd_leak(BadExtract, 1), + + BadCreate = fun() -> + {error,enoent} = zip:zip("failed.zip", + ["none"]), + ok + end, + do_fd_leak(BadCreate, 1), + + ok. + +do_fd_leak(_Bad, 10000) -> + ok; +do_fd_leak(Bad, N) -> + try Bad() of + ok -> + do_fd_leak(Bad, N + 1) + catch + C:R -> + Stk = erlang:get_stacktrace(), + io:format("Bad error after ~p attempts\n", [N]), + erlang:raise(C, R, Stk) + end. diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index 2801aa8ae7..241590b850 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -36,7 +36,7 @@ "Tags that can be used anywhere within a module.") (defvar erlang-edoc-overview-tags - '("author" "copyright" "reference" "see" "since" "title" "version") + '("author" "copyright" "doc" "reference" "see" "since" "title" "version") "Tags that can be used in an overview file.") (defvar erlang-edoc-module-tags @@ -45,8 +45,8 @@ "Tags that can be used before a module declaration.") (defvar erlang-edoc-function-tags - '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec" - "throws" "type") + '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns" + "see" "since" "spec" "throws" "type") "Tags that can be used before a function definition.") (defvar erlang-edoc-predefined-macros diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index eeba7f34e9..bdb3d9ad4a 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010-2016. All Rights Reserved. +;; Copyright Ericsson AB 2010-2017. All Rights Reserved. ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -915,11 +915,7 @@ Please see the function `tempo-define-template'.") "%% process to initialize." n (erlang-skel-separator-end 2) "-spec init(Args :: term()) ->" n> - "{ok, State :: term(), Data :: term()} |" n> - "{ok, State :: term(), Data :: term()," n> - "[gen_statem:action()] | gen_statem:action()} |" n> - "ignore |" n> - "{stop, Reason :: term()}." n + "gen_statem:init_result(atom())." n "init([]) ->" n> "process_flag(trap_exit, true)," n> "{ok, state_name, #data{}}." n @@ -1028,11 +1024,7 @@ Please see the function `tempo-define-template'.") "%% process to initialize." n (erlang-skel-separator-end 2) "-spec init(Args :: term()) ->" n> - "{ok, State :: term(), Data :: term()} |" n> - "{ok, State :: term(), Data :: term()," n> - "[gen_statem:action()] | gen_statem:action()} |" n> - "ignore |" n> - "{stop, Reason :: term()}." n + "gen_statem:init_result(term())." n "init([]) ->" n> "process_flag(trap_exit, true)," n> "{ok, state_name, #data{}}." n diff --git a/lib/tools/examples/xref_examples.erl b/lib/tools/examples/xref_examples.erl index 4c082195a2..f7e71c9708 100644 --- a/lib/tools/examples/xref_examples.erl +++ b/lib/tools/examples/xref_examples.erl @@ -7,7 +7,7 @@ %% ${HOME}/unused_locals.txt. script() -> Root = code:root_dir(), - Dir = os:getenv("HOME"), + {ok,[[Dir]]} = init:get_argument(home), Server = s, xref:start(Server), {ok, _Relname} = xref:add_release(Server, code:lib_dir(), {name,otp}), diff --git a/lib/typer/src/typer.app.src b/lib/typer/src/typer.app.src index 974091b44c..e0be937cc3 100644 --- a/lib/typer/src/typer.app.src +++ b/lib/typer/src/typer.app.src @@ -7,5 +7,5 @@ {registered, []}, {applications, [compiler, dialyzer, hipe, kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", - "dialyzer-2.7","compiler-5.0"]}]}. + {runtime_dependencies, ["stdlib-3.0","kernel-5.0","hipe-3.15.4","erts-8.0", + "dialyzer-3.1","compiler-7.0"]}]}. diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 5c82750a21..cd67af41ed 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -143,8 +143,9 @@ extract(#analysis{macros = Macros, MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), - CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), - dialyzer_contracts:process_contract_remote_types(CodeServer4) + {CodeServer4, RecordDict} = + dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -156,7 +157,7 @@ extract(#analysis{macros = Macros, fun(Module, TmpPlt) -> {ok, ModuleContracts} = dict:find(Module, Contracts), SpecList = [{MFA, Contract} - || {MFA, {_FileLine, Contract}} <- dict:to_list(ModuleContracts)], + || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)], dialyzer_plt:insert_contract_list(TmpPlt, SpecList) end, NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules), @@ -172,8 +173,10 @@ get_type_info(#analysis{callgraph = CallGraph, StrippedCallGraph = remove_external(CallGraph, TrustPLT), %% io:format("--- Analyzing callgraph... "), try - NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, - TrustPLT, CodeServer), + NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, + TrustPLT, + CodeServer), + NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt), Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt} catch error:What -> @@ -224,7 +227,7 @@ get_external(Exts, Plt) -> -type fa() :: {atom(), arity()}. -type func_info() :: {line(), atom(), arity()}. --record(info, {records = map__new() :: map_dict(), +-record(info, {records = maps:new() :: erl_types:type_table(), functions = [] :: [func_info()], types = map__new() :: map_dict(), edoc = false :: boolean()}). @@ -267,7 +270,7 @@ write_inc_files(Inc) -> Functions = [Key || {Key, _} <- Val], Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val], Info = #info{types = map__from_list(Val1), - records = map__new(), + records = maps:new(), %% Note we need to sort functions here! functions = lists:keysort(1, Functions)}, %% io:format("Types ~p\n", [Info#info.types]), @@ -849,8 +852,9 @@ collect_info(Analysis) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict) catch throw:{error, ErrorMsg} -> fatal_error(ErrorMsg) diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl index 318a0cf7f4..1aef6c58c4 100644 --- a/lib/xmerl/src/xmerl_sax_parser.erl +++ b/lib/xmerl/src/xmerl_sax_parser.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,6 +33,7 @@ %% External exports %%---------------------------------------------------------------------- -export([file/2, + stream/3, stream/2]). %%---------------------------------------------------------------------- @@ -72,11 +73,12 @@ file(Name,Options) -> File = filename:basename(Name), ContinuationFun = fun default_continuation_cb/1, Res = stream(<<>>, - [{continuation_fun, ContinuationFun}, - {continuation_state, FD}, - {current_location, CL}, - {entity, File} - |Options]), + [{continuation_fun, ContinuationFun}, + {continuation_state, FD}, + {current_location, CL}, + {entity, File} + |Options], + file), ok = file:close(FD), Res end. @@ -92,19 +94,22 @@ file(Name,Options) -> %% EventState = term() %% Description: Parse a stream containing an XML document. %%---------------------------------------------------------------------- -stream(Xml, Options) when is_list(Xml), is_list(Options) -> +stream(Xml, Options) -> + stream(Xml, Options, stream). + +stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) -> State = parse_options(Options, initial_state()), - case State#xmerl_sax_parser_state.file_type of + case State#xmerl_sax_parser_state.file_type of dtd -> xmerl_sax_parser_list:parse_dtd(Xml, State#xmerl_sax_parser_state{encoding = list, - input_type = stream}); + input_type = InputType}); normal -> xmerl_sax_parser_list:parse(Xml, State#xmerl_sax_parser_state{encoding = list, - input_type = stream}) + input_type = InputType}) end; -stream(Xml, Options) when is_binary(Xml), is_list(Options) -> +stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) -> case parse_options(Options, initial_state()) of {error, Reason} -> {error, Reason}; State -> @@ -127,7 +132,7 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) -> State#xmerl_sax_parser_state.event_state}; {Xml1, State1} -> parse_binary(Xml1, - State1#xmerl_sax_parser_state{input_type = stream}, + State1#xmerl_sax_parser_state{input_type = InputType}, ParseFunction) end end. @@ -226,12 +231,12 @@ check_encoding_option(E) -> %% Description: Detects which character set is used in a binary stream. %%---------------------------------------------------------------------- detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) -> - throw({error, "Can't detect character encoding due to no indata"}); + {error, "Can't detect character encoding due to no indata"}; detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State) -> case CFun(CState) of {<<>>, _} -> - throw({error, "Can't detect character encoding due to lack of indata"}); + {error, "Can't detect character encoding due to lack of indata"}; {NewBytes, NewContState} -> detect_charset(NewBytes, State#xmerl_sax_parser_state{continuation_state = NewContState}) end; diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl index 932ab0cec5..7f9bf6c4d3 100644 --- a/lib/xmerl/src/xmerl_sax_parser.hrl +++ b/lib/xmerl/src/xmerl_sax_parser.hrl @@ -88,14 +88,7 @@ current_location, % Location of the currently parsed XML entity entity, % Parsed XML entity skip_external_dtd = false,% If true the external DTD is skipped during parsing - input_type % Source type: file | stream. - % This field is a preparation for an fix in R17 of a bug in - % the conformance against the standard. - % Today a file which contains two XML documents will be considered - % well-formed and the second is placed in the rest part of the - % return tuple, according to the conformance tests this should fail. - % In the future this will fail if xmerl_sax_aprser:file/2 is used but - % left to the user in the xmerl_sax_aprser:stream/2 case. + input_type % Source type: file | stream }). diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 4d75805b9b..f3470b2809 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -1,7 +1,7 @@ %%-*-erlang-*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -72,7 +72,12 @@ parse(Xml, State) -> {ok, Rest, State2} -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), - {ok, State3#xmerl_sax_parser_state.event_state, Rest}; + case check_if_rest_ok(State3#xmerl_sax_parser_state.input_type, Rest) of + true -> + {ok, State3#xmerl_sax_parser_state.event_state, Rest}; + false -> + format_error(fatal_error, State3, "Input found after legal document") + end; {fatal_error, {State2, Reason}} -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), @@ -81,10 +86,14 @@ parse(Xml, State) -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), format_error(Tag, State3, Reason); + {endDocument, Rest, State2} -> + State3 = event_callback(endDocument, State2), + ets:delete(RefTable), + {ok, State3#xmerl_sax_parser_state.event_state, Rest}; Other -> _State2 = event_callback(endDocument, State1), ets:delete(RefTable), - throw(Other) + {fatal_error, Other} end. %%---------------------------------------------------------------------- @@ -111,7 +120,7 @@ parse_dtd(Xml, State) -> {Rest, State2} when is_record(State2, xmerl_sax_parser_state) -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), - {ok, State3#xmerl_sax_parser_state.event_state, Rest}; + {ok, State3#xmerl_sax_parser_state.event_state, Rest}; {endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), @@ -119,7 +128,7 @@ parse_dtd(Xml, State) -> Other -> _State2 = event_callback(endDocument, State1), ets:delete(RefTable), - throw(Other) + {fatal_error, Other} end. @@ -136,10 +145,11 @@ parse_dtd(Xml, State) -> %% [1] document ::= prolog element Misc* %%---------------------------------------------------------------------- parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> - {Rest1, State1} = parse_xml_decl(Rest, State), + {Rest1, State1} = parse_byte_order_mark(Rest, State), {Rest2, State2} = parse_misc(Rest1, State1, true), {ok, Rest2, State2}. +?PARSE_BYTE_ORDER_MARK(Bytes, State). %%---------------------------------------------------------------------- %% Function: parse_xml_decl(Rest, State) -> Result @@ -150,15 +160,8 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' %%---------------------------------------------------------------------- --dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> - cf(?BYTE_ORDER_MARK_1, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_2, State) -> - cf(?BYTE_ORDER_MARK_2, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_REST(Rest), State) -> - cf(Rest, State, fun parse_xml_decl/2); parse_xml_decl(?STRING("<") = Bytes, State) -> cf(Bytes, State, fun parse_xml_decl/2); parse_xml_decl(?STRING("<?") = Bytes, State) -> @@ -170,31 +173,19 @@ parse_xml_decl(?STRING("<?xm") = Bytes, State) -> parse_xml_decl(?STRING("<?xml") = Bytes, State) -> cf(Bytes, State, fun parse_xml_decl/2); parse_xml_decl(?STRING_REST("<?xml", Rest1), State) -> - parse_xml_decl_1(Rest1, State); -parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> - case unicode:characters_to_list(Bytes, Enc) of - {incomplete, _, _} -> - cf(Bytes, State, fun parse_xml_decl/2); - {error, _Encoded, _Rest} -> - ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); - _ -> - parse_prolog(Bytes, State) - end; -parse_xml_decl(Bytes, State) -> - parse_prolog(Bytes, State). - + parse_xml_decl_rest(Rest1, State); +?PARSE_XML_DECL(Bytes, State). -parse_xml_decl_1(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> +parse_xml_decl_rest(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> if ?is_whitespace(C) -> {_XmlAttributes, Rest1, State1} = parse_version_info(Rest, State, []), - %State2 = event_callback({processingInstruction, "xml", XmlAttributes}, State1),% The XML decl. should not be reported as a PI parse_prolog(Rest1, State1); true -> parse_prolog(?STRING_REST("<?xml", Bytes), State) end; -parse_xml_decl_1(Bytes, State) -> - unicode_incomplete_check([Bytes, State, fun parse_xml_decl_1/2], undefined). +parse_xml_decl_rest(Bytes, State) -> + unicode_incomplete_check([Bytes, State, fun parse_xml_decl_rest/2], undefined). @@ -216,8 +207,6 @@ parse_prolog(?STRING_REST("<?", Rest), State) -> parse_prolog(Rest1, State1); {endDocument, Rest1, State1} -> parse_prolog(Rest1, State1) - % IValue = ?TO_INPUT_FORMAT("<?"), - % {?APPEND_STRING(IValue, Rest1), State1} end; parse_prolog(?STRING_REST("<!", Rest), State) -> parse_prolog_1(Rest, State); @@ -230,7 +219,6 @@ parse_prolog(Bytes, State) -> unicode_incomplete_check([Bytes, State, fun parse_prolog/2], "expecting < or whitespace"). - parse_prolog_1(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_prolog_1/2); parse_prolog_1(?STRING("D") = Bytes, State) -> @@ -442,6 +430,15 @@ check_if_new_doc_allowed(stream, []) -> check_if_new_doc_allowed(_, _) -> false. +check_if_rest_ok(file, []) -> + true; +check_if_rest_ok(file, <<>>) -> + true; +check_if_rest_ok(stream, _) -> + true; +check_if_rest_ok(_, _) -> + false. + %%---------------------------------------------------------------------- %% Function: parse_pi_1(Rest, State) -> Result %% Input: Rest = string() | binary() @@ -1024,16 +1021,21 @@ parse_etag(Bytes, State) -> unicode_incomplete_check([Bytes, State, fun parse_etag/2], undefined). - parse_etag_1(?STRING_REST(">", Rest), #xmerl_sax_parser_state{end_tags=[{_ETag, Uri, LocalName, QName, OldNsList, NewNsList} - |RestOfETags]} = State, _Tag) -> + |RestOfETags], + input_type=InputType} = State, _Tag) -> State1 = event_callback({endElement, Uri, LocalName, QName}, State), State2 = send_end_prefix_mapping_event(NewNsList, State1), - parse_content(Rest, - State2#xmerl_sax_parser_state{end_tags=RestOfETags, - ns = OldNsList}, - [], true); + case check_if_new_doc_allowed(InputType, RestOfETags) of + true -> + throw({endDocument, Rest, State2#xmerl_sax_parser_state{ns = OldNsList}}); + false -> + parse_content(Rest, + State2#xmerl_sax_parser_state{end_tags=RestOfETags, + ns = OldNsList}, + [], true) + end; parse_etag_1(?STRING_UNBOUND_REST(_C, _), State, Tag) -> {P,TN} = Tag, ?fatal_error(State, "Bad EndTag: " ++ P ++ ":" ++ TN); @@ -1051,21 +1053,26 @@ parse_etag_1(Bytes, State, Tag) -> %% Description: Parsing the content part of tags %% [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)* %%---------------------------------------------------------------------- - parse_content(?STRING_EMPTY, State, Acc, IgnorableWS) -> - case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of - {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> - {Rest, State1}; - {fatal_error, {State1, Msg}} -> - case check_if_document_complete(State1, Msg) of - true -> - State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1), - {?STRING_EMPTY, State2}; - false -> - ?fatal_error(State1, Msg) - end; - Other -> - throw(Other) + case check_if_document_complete(State, "No more bytes") of + true -> + State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State), + {?STRING_EMPTY, State1}; + false -> + case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of + {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> + {Rest, State1}; + {fatal_error, {State1, Msg}} -> + case check_if_document_complete(State1, Msg) of + true -> + State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1), + {?STRING_EMPTY, State2}; + false -> + ?fatal_error(State1, Msg) + end; + Other -> + throw(Other) + end end; parse_content(?STRING("\r") = Bytes, State, Acc, IgnorableWS) -> cf(Bytes, State, Acc, IgnorableWS, fun parse_content/4); @@ -1094,7 +1101,7 @@ parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) -> parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) -> case ET of [] -> - {Rest, State}; %%LATH : Skicka ignorable WS ??? + {Rest, State}; %% Skicka ignorable WS ??? _ -> State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State), parse_cdata(Rest1, State1) @@ -1102,7 +1109,7 @@ parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags parse_content(?STRING_REST("<", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) -> case ET of [] -> - {Rest, State}; %%LATH : Skicka ignorable WS ??? + {Rest, State}; %% Skicka ignorable WS ??? _ -> State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State), parse_stag(Rest1, State1) @@ -1204,7 +1211,6 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- --dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1230,16 +1236,7 @@ whitespace(?STRING_REST("\r", Rest), State, Acc) -> whitespace(Rest, State#xmerl_sax_parser_state{line_no=N+1}, [?lf |Acc]); whitespace(?STRING_UNBOUND_REST(C, Rest), State, Acc) when ?is_whitespace(C) -> whitespace(Rest, State, [C|Acc]); -whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> - {lists:reverse(Acc), Bytes, State}; -whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> - case unicode:characters_to_list(Bytes, Enc) of - {incomplete, _, _} -> - cf(Bytes, State, Acc, fun whitespace/3); - {error, _Encoded, _Rest} -> - ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) - end. - +?WHITESPACE(Bytes, State, Acc). %%---------------------------------------------------------------------- %% Function: parse_reference(Rest, State, HaveToExist) -> Result @@ -1362,7 +1359,6 @@ parse_pe_reference_1(Bytes, State, Name) -> "missing ; after reference " ++ Name). - %%---------------------------------------------------------------------- %% Function: insert_reference(Reference, State) -> Result %% Parameters: Reference = string() @@ -1378,7 +1374,6 @@ insert_reference({Name, Type, Value}, Table) -> end. - %%---------------------------------------------------------------------- %% Function: look_up_reference(Reference, State) -> Result %% Parameters: Reference = string() @@ -1693,7 +1688,7 @@ handle_external_entity({http, Url}, State) -> ++ file:format_error(Reason)); {ok, FD} -> {?STRING_EMPTY, EntityState} = - parse_external_entity_1(<<>>, + parse_external_entity_byte_order_mark(<<>>, State#xmerl_sax_parser_state{continuation_state=FD, current_location=filename:dirname(Url), entity=filename:basename(Url), @@ -1709,6 +1704,8 @@ handle_external_entity({http, Url}, State) -> handle_external_entity({Tag, _Url}, State) -> ?fatal_error(State, "Unsupported URI type: " ++ atom_to_list(Tag)). +?PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State). + %%---------------------------------------------------------------------- %% Function : parse_external_entity_1(Rest, State) -> Result %% Parameters: Rest = string() | binary() @@ -1716,7 +1713,6 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- --dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> @@ -1726,12 +1722,6 @@ parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = Other -> throw(Other) end; -parse_external_entity_1(?BYTE_ORDER_MARK_1, State) -> - cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_1/2); -parse_external_entity_1(?BYTE_ORDER_MARK_2, State) -> - cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_1/2); -parse_external_entity_1(?BYTE_ORDER_MARK_REST(Rest), State) -> - parse_external_entity_1(Rest, State); parse_external_entity_1(?STRING("<") = Bytes, State) -> cf(Bytes, State, fun parse_external_entity_1/2); parse_external_entity_1(?STRING("<?") = Bytes, State) -> @@ -3290,7 +3280,7 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C catch throw:ErrorTerm -> ?fatal_error(State, ErrorTerm); - exit:Reason -> + exit:Reason -> ?fatal_error(State, {'EXIT', Reason}) end, case Result of diff --git a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc index 961806bf4c..6e59347fb8 100644 --- a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,8 +34,36 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, latin1)). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, undefined_bom2). --define(BYTE_ORDER_MARK_REST(Rest), <<undefined, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc index 624a621d92..6a4435b1d9 100644 --- a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc @@ -36,6 +36,19 @@ %% In the list case we can't use a '++' when matchin against an unbound variable -define(STRING_UNBOUND_REST(MatchChar, Rest), [MatchChar | Rest]). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, undefined_bom2). --define(BYTE_ORDER_MARK_REST(Rest), [undefined|Rest]). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc index ff84ece97a..ec89024729 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,8 +34,50 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, big})). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/big-utf16, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, <<16#FE>>). +-define(BYTE_ORDER_MARK_1, <<16#FE>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#FE, 16#FF, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc index a330fce8d0..566333a045 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,8 +34,50 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, little})). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/little-utf16, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, <<16#FF>>). +-define(BYTE_ORDER_MARK_1, <<16#FF>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#FF, 16#FE, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc index d46d60d237..f41d06d013 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,11 +34,55 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, utf8)). - -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/utf8, Rest/binary>>). -define(BYTE_ORDER_MARK_1, <<16#EF>>). -define(BYTE_ORDER_MARK_2, <<16#EF, 16#BB>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#EF, 16#BB, 16#BF, Rest/binary>>). +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_2, State) -> + cf(?BYTE_ORDER_MARK_2, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_2, State) -> + cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 5e0459ec21..95dc82e5c9 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2225,16 +2225,18 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, AllAttrs = case S#xmerl_scanner.default_attrs of true -> - [ #xmlAttribute{name = AttName, - parents = [{Name, Pos} | Parents], - language = Lang, - nsinfo = NSI, - namespace = Namespace, - value = AttValue, - normalized = true} || - {AttName, AttValue} <- get_default_attrs(S, Name), - AttValue =/= no_value, - not lists:keymember(AttName, #xmlAttribute.name, Attrs) ]; + DefaultAttrs = + [ #xmlAttribute{name = AttName, + parents = [{Name, Pos} | Parents], + language = Lang, + nsinfo = NSI, + namespace = Namespace, + value = AttValue, + normalized = true} || + {AttName, AttValue} <- get_default_attrs(S, Name), + AttValue =/= no_value, + not lists:keymember(AttName, #xmlAttribute.name, Attrs) ], + lists:append(Attrs, DefaultAttrs); false -> Attrs end, @@ -2307,7 +2309,9 @@ expanded_name(Name, [], #xmlNamespace{default = URI}, S) -> expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> {_, Value} = lists:keyfind(Local, 1, Ns), case Name of - 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> + 'xmlns:xml' when Value =:= 'http://www.w3.org/XML/1998/namespace' -> + N; + 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> ?fatal({xml_prefix_cannot_be_redeclared, Value}, S); 'xmlns:xmlns' -> ?fatal({xmlns_prefix_cannot_be_declared, Value}, S); @@ -2321,6 +2325,8 @@ expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> N end end; +expanded_name(_Name, {"xml", Local}, _NS, _S) -> + {'http://www.w3.org/XML/1998/namespace', list_to_atom(Local)}; expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> case lists:keysearch(Prefix, 1, Ns) of {value, {_, URI}} -> @@ -2331,9 +2337,6 @@ expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> ?fatal({namespace_prefix_not_declared, Prefix}, S) end. - - - keyreplaceadd(K, Pos, [H|T], Obj) when K == element(Pos, H) -> [Obj|T]; keyreplaceadd(K, Pos, [H|T], Obj) -> diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile index 7a326e334f..b13fee05b3 100644 --- a/lib/xmerl/test/Makefile +++ b/lib/xmerl/test/Makefile @@ -55,7 +55,8 @@ SUITE_FILES= \ xmerl_xsd_SUITE.erl \ xmerl_xsd_MS2002-01-16_SUITE.erl \ xmerl_xsd_NIST2002-01-16_SUITE.erl \ - xmerl_xsd_Sun2002-01-16_SUITE.erl + xmerl_xsd_Sun2002-01-16_SUITE.erl \ + xmerl_sax_stream_SUITE.erl XML_FILES= \ testcases.dtd \ @@ -125,4 +126,5 @@ release_tests_spec: opt @tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) @tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) @tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) chmod -R u+w "$(RELSYSDIR)" diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index e97b8c6a4b..58c462483c 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -54,7 +54,8 @@ groups() -> cpd_expl_provided_DTD]}, {misc, [], [latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3, - pe_ref1, copyright, testXSEIF, export_simple1, export]}, + pe_ref1, copyright, testXSEIF, export_simple1, export, + default_attrs_bug, xml_ns]}, {eventp_tests, [], [sax_parse_and_export]}, {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, @@ -223,6 +224,50 @@ syntax_bug3(Config) -> Err -> Err end. +default_attrs_bug(Config) -> + file:set_cwd(datadir(Config)), + Doc = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = a, value = "explicit"}, + #xmlAttribute{name = b, value = "default"}]}, + [] + } = xmerl_scan:string(Doc, [{default_attrs, true}]), + Doc2 = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc b=\"also explicit\" a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"}, + #xmlAttribute{name = a, value = "explicit"}]}, + [] + } = xmerl_scan:string(Doc2, [{default_attrs, true}]), + ok. + + +xml_ns(Config) -> + Doc = "<?xml version='1.0'?>\n" + "<doc xml:attr1=\"implicit xml ns\"/>", + {#xmlElement{namespace=#xmlNamespace{default = [], nodes = []}, + attributes = [#xmlAttribute{name = 'xml:attr1', + expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1}, + nsinfo = {"xml","attr1"}, + namespace = #xmlNamespace{default = [], nodes = []}}]}, + [] + } = xmerl_scan:string(Doc, [{namespace_conformant, true}]), + Doc2 = "<?xml version='1.0'?>\n" + "<doc xmlns:xml=\"http://www.w3.org/XML/1998/namespace\" xml:attr1=\"explicit xml ns\"/>", + {#xmlElement{namespace=#xmlNamespace{default = [], nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}, + attributes = [#xmlAttribute{name = 'xmlns:xml', + expanded_name = {"xmlns","xml"}, + nsinfo = {"xmlns","xml"}, + namespace = #xmlNamespace{default = [], + nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}, + #xmlAttribute{name = 'xml:attr1', + expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1}, + nsinfo = {"xml","attr1"}, + namespace = #xmlNamespace{default = [], + nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}]}, + [] + } = xmerl_scan:string(Doc2, [{namespace_conformant, true}]), + ok. + pe_ref1(Config) -> file:set_cwd(datadir(Config)), {#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]). diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl index f5c0a783c4..7d1a70905c 100644 --- a/lib/xmerl/test/xmerl_sax_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_SUITE.erl @@ -85,17 +85,17 @@ ticket_11551(_Config) -> <a>hej</a> <?xml version=\"1.0\" encoding=\"utf-8\" ?> <a>hej</a>">>, - {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []), + {ok, undefined, <<"\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []), Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?> <a>hej</a> <?xml version=\"1.0\" encoding=\"utf-8\" ?> <a>hej</a>">>, - {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []), + {ok, undefined, <<"\n\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []), Stream3= <<"<a>hej</a> <?xml version=\"1.0\" encoding=\"utf-8\" ?> <a>hej</a>">>, - {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []), + {ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []), ok. diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl index 525a3b175a..b8412206cc 100644 --- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl @@ -2,7 +2,7 @@ %%---------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -507,11 +507,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-036'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/036.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -522,11 +519,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-037'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/037.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<" \r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -561,11 +555,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-040'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/040.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -576,11 +567,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-041'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/041.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -603,11 +591,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-043'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/043.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -618,11 +603,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-044'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/044.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"<doc/>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -669,11 +651,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-048'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/048.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"<![CDATA[]]>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -1416,11 +1395,8 @@ end_per_testcase(_Func,_Config) -> 'not-wf-sa-110'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/110.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"&e;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -1914,9 +1890,9 @@ end_per_testcase(_Func,_Config) -> %% Special case becase we returns everything after a legal document %% as an rest instead of giving and error to let the user handle %% multipple docs on a stream. - {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), - % check_result(R, "not-wf"). + %{ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -7784,11 +7760,8 @@ end_per_testcase(_Func,_Config) -> 'o-p01fail3'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"oasis","p01fail3.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_, <<"<bad/>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -11417,12 +11390,8 @@ end_per_testcase(_Func,_Config) -> 'ibm-not-wf-P01-ibm01n02'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n02.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), - % check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -11433,11 +11402,8 @@ end_per_testcase(_Func,_Config) -> 'ibm-not-wf-P01-ibm01n03'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n03.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_, <<"<title>Wrong combination!</title>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Cases @@ -13027,11 +12993,8 @@ end_per_testcase(_Func,_Config) -> 'ibm-not-wf-P27-ibm27n01'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P27/ibm27n01.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_, <<"<!ELEMENT cat EMPTY>">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Cases @@ -13461,11 +13424,8 @@ end_per_testcase(_Func,_Config) -> 'ibm-not-wf-P39-ibm39n06'(Config) -> file:set_cwd(xmerl_test_lib:get_data_dir(Config)), Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P39/ibm39n06.xml"]), - %% Special case becase we returns everything after a legal document - %% as an rest instead of giving and error to let the user handle - %% multipple docs on a stream. - {ok,_,<<"content after end tag\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%check_result(R, "not-wf"). + R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Cases diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl new file mode 100644 index 0000000000..a306eb66a2 --- /dev/null +++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl @@ -0,0 +1,245 @@ +%%-*-erlang-*- +%%---------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%%---------------------------------------------------------------------- +%% File : xmerl_sax_stream_SUITE.erl +%%---------------------------------------------------------------------- +-module(xmerl_sax_stream_SUITE). +-compile(export_all). + +%%---------------------------------------------------------------------- +%% Include files +%%---------------------------------------------------------------------- +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). + +%%====================================================================== +%% External functions +%%====================================================================== + +%%---------------------------------------------------------------------- +%% Initializations +%%---------------------------------------------------------------------- +all() -> + [ + one_document, + two_documents, + one_document_and_junk + ]. + +%%---------------------------------------------------------------------- +%% Initializations +%%---------------------------------------------------------------------- + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_Func, _Config) -> + ok. + +%%---------------------------------------------------------------------- +%% Tests +%%---------------------------------------------------------------------- +one_document(Config) -> + Port = 11111, + + {ok, ListenSocket} = listen(Port), + Self = self(), + + spawn( + fun() -> + case catch gen_tcp:accept(ListenSocket) of + {ok, S} -> + Result = xmerl_sax_parser:stream(<<>>, + [{continuation_state, S}, + {continuation_fun, + fun(Sd) -> + io:format("Continuation called!!", []), + case gen_tcp:recv(Sd, 0) of + {ok, Packet} -> + io:format("Packet: ~p\n", [Packet]), + {Packet, Sd}; + {error, Reason} -> + throw({error, Reason}) + end + end}]), + Self ! {xmerl_sax, Result}, + close(S); + Error -> + Self ! {xmerl_sax, {error, {accept, Error}}} + end + end), + + {ok, SendSocket} = connect(localhost, Port), + + {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one.xml"])), + + send_chunks(SendSocket, Binary), + + receive + {xmerl_sax, {ok, undefined, Rest}} -> + <<"\n">> = Rest, + io:format("Ok Rest: ~p\n", [Rest]) + after 5000 -> + ct:fail("Timeout") + end, + ok. + +two_documents(Config) -> + Port = 11111, + + {ok, ListenSocket} = listen(Port), + Self = self(), + + spawn( + fun() -> + case catch gen_tcp:accept(ListenSocket) of + {ok, S} -> + Result = xmerl_sax_parser:stream(<<>>, + [{continuation_state, S}, + {continuation_fun, + fun(Sd) -> + io:format("Continuation called!!", []), + case gen_tcp:recv(Sd, 0) of + {ok, Packet} -> + io:format("Packet: ~p\n", [Packet]), + {Packet, Sd}; + {error, Reason} -> + throw({error, Reason}) + end + end}]), + Self ! {xmerl_sax, Result}, + close(S); + Error -> + Self ! {xmerl_sax, {error, {accept, Error}}} + end + end), + + {ok, SendSocket} = connect(localhost, Port), + + {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_two.xml"])), + + send_chunks(SendSocket, Binary), + + receive + {xmerl_sax, {ok, undefined, Rest}} -> + <<"\n<?x", _R/binary>> = Rest, + io:format("Ok Rest: ~p\n", [Rest]) + after 5000 -> + ct:fail("Timeout") + end, + ok. + +one_document_and_junk(Config) -> + Port = 11111, + + {ok, ListenSocket} = listen(Port), + Self = self(), + + spawn( + fun() -> + case catch gen_tcp:accept(ListenSocket) of + {ok, S} -> + Result = xmerl_sax_parser:stream(<<>>, + [{continuation_state, S}, + {continuation_fun, + fun(Sd) -> + io:format("Continuation called!!", []), + case gen_tcp:recv(Sd, 0) of + {ok, Packet} -> + io:format("Packet: ~p\n", [Packet]), + {Packet, Sd}; + {error, Reason} -> + throw({error, Reason}) + end + end}]), + Self ! {xmerl_sax, Result}, + close(S); + Error -> + Self ! {xmerl_sax, {error, {accept, Error}}} + end + end), + + {ok, SendSocket} = connect(localhost, Port), + + {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one_junk.xml"])), + + send_chunks(SendSocket, Binary), + + receive + {xmerl_sax, {ok, undefined, Rest}} -> + <<"\nth", _R/binary>> = Rest, + io:format("Ok Rest: ~p\n", [Rest]) + after 10000 -> + ct:fail("Timeout") + end, + ok. + +%%---------------------------------------------------------------------- +%% Utility functions +%%---------------------------------------------------------------------- +listen(Port) -> + case catch gen_tcp:listen(Port, [{active, false}, + binary, + {keepalive, true}, + {reuseaddr,true}]) of + {ok, ListenSocket} -> + {ok, ListenSocket}; + {error, Reason} -> + {error, {listen, Reason}} + end. + +close(Socket) -> + (catch gen_tcp:close(Socket)). + +connect(Host, Port) -> + Timeout = 5000, + % Options1 = check_options(Options), + Options = [binary], + case catch gen_tcp:connect(Host, Port, Options, Timeout) of + {ok, Socket} -> + {ok, Socket}; + {error, Reason} -> + {error, Reason} + end. + +send_chunks(Socket, Binary) -> + BSize = erlang:size(Binary), + if + BSize > 25 -> + <<Head:25/binary, Tail/binary>> = Binary, + case gen_tcp:send(Socket, Head) of + ok -> + timer:sleep(1000), + send_chunks(Socket, Tail); + {error,closed} -> + ok + end; + true -> + gen_tcp:send(Socket, Binary) + end. + +datadir(Config) -> + proplists:get_value(data_dir, Config). diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml new file mode 100644 index 0000000000..30328bb188 --- /dev/null +++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml @@ -0,0 +1,17 @@ +<?xml version="1.0"?> +<person> +<name> +Arne Andersson +</name> +<address> +<street> + Old Road 456 +</street> +<zip> +12323 +</zip> +<city> +Small City +</city> +</address> +</person> diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml new file mode 100644 index 0000000000..f730a95865 --- /dev/null +++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml @@ -0,0 +1,18 @@ +<?xml version="1.0"?> +<person> +<name> +Arne Andersson +</name> +<address> +<street> + Old Road 456 +</street> +<zip> +12323 +</zip> +<city> +Small City +</city> +</address> +</person> +this is junk ...... diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml new file mode 100644 index 0000000000..e241a02190 --- /dev/null +++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml @@ -0,0 +1,34 @@ +<?xml version="1.0"?> +<person> +<name> +Arne Andersson +</name> +<address> +<street> + Old Road 456 +</street> +<zip> +12323 +</zip> +<city> +Small City +</city> +</address> +</person> +<?xml version="1.0"?> +<person> +<name> +Bertil Bengtson +</name> +<address> +<street> + New Road 4 +</street> +<zip> +12328 +</zip> +<city> +Small City +</city> +</address> +</person> |