diff options
38 files changed, 1403 insertions, 325 deletions
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 8b772a011c..4c7c910419 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -379,6 +379,18 @@ info(fmtfn_t to, void *to_arg)  } +static int code_size(struct erl_module_instance* modi) +{ +    int size = modi->code_length; + +    if (modi->code_hdr) { +        ErtsLiteralArea* lit = modi->code_hdr->literal_area; +        if (lit) +            size += (lit->end - lit->start) * sizeof(Eterm); +    } +    return size; +} +  void  loaded(fmtfn_t to, void *to_arg)  { @@ -396,13 +408,9 @@ loaded(fmtfn_t to, void *to_arg)       * Calculate and print totals.       */      for (i = 0; i < module_code_size(code_ix); i++) { -	if ((modp = module_code(i, code_ix)) != NULL && -	    ((modp->curr.code_length != 0) || -	     (modp->old.code_length != 0))) { -	    cur += modp->curr.code_length; -	    if (modp->old.code_length != 0) { -		old += modp->old.code_length; -	    } +	if ((modp = module_code(i, code_ix)) != NULL) { +	    cur += code_size(&modp->curr); +            old += code_size(&modp->old);  	}      }      erts_print(to, to_arg, "Current code: %d\n", cur); @@ -418,31 +426,25 @@ loaded(fmtfn_t to, void *to_arg)  	    /*  	     * Interactive dump; keep it brief.  	     */ -	    if (modp != NULL && -	    ((modp->curr.code_length != 0) || -	     (modp->old.code_length != 0))) { -		erts_print(to, to_arg, "%T", make_atom(modp->module)); -		cur += modp->curr.code_length; -		erts_print(to, to_arg, " %d", modp->curr.code_length ); -		if (modp->old.code_length != 0) { -		    erts_print(to, to_arg, " (%d old)", -			       modp->old.code_length ); -		    old += modp->old.code_length; -		} +	    if (modp != NULL && ((modp->curr.code_length != 0) || +                                 (modp->old.code_length != 0))) { +		erts_print(to, to_arg, "%T %d", make_atom(modp->module), +                           code_size(&modp->curr)); +		if (modp->old.code_length != 0) +		    erts_print(to, to_arg, " (%d old)", code_size(&modp->old));  		erts_print(to, to_arg, "\n");  	    }  	} else {  	    /*  	     * To crash dump; make it parseable.  	     */ -	    if (modp != NULL && -		((modp->curr.code_length != 0) || -		 (modp->old.code_length != 0))) { +	    if (modp != NULL && ((modp->curr.code_length != 0) || +                                 (modp->old.code_length != 0))) {  		erts_print(to, to_arg, "=mod:");  		erts_print(to, to_arg, "%T", make_atom(modp->module));  		erts_print(to, to_arg, "\n");  		erts_print(to, to_arg, "Current size: %d\n", -			   modp->curr.code_length); +			   code_size(&modp->curr));  		code = modp->curr.code_hdr;  		if (code != NULL && code->attr_ptr) {  		    erts_print(to, to_arg, "Current attributes: "); @@ -456,7 +458,7 @@ loaded(fmtfn_t to, void *to_arg)  		}  		if (modp->old.code_length != 0) { -		    erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length); +		    erts_print(to, to_arg, "Old size: %d\n", code_size(&modp->old));  		    code = modp->old.code_hdr;  		    if (code->attr_ptr) {  			erts_print(to, to_arg, "Old attributes: "); diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c index b42d2dc28b..74cf7cf11a 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -157,7 +157,7 @@ BIF_RETTYPE round_1(BIF_ALIST_1)      GET_DOUBLE(BIF_ARG_1, f);      /* round it and return the resultant integer */ -    res = double_to_integer(BIF_P, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5); +    res = double_to_integer(BIF_P, round(f.fd));      BIF_RET(res);  } @@ -597,8 +597,7 @@ Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live)      }      GET_DOUBLE(arg, f); -    return gc_double_to_integer(p, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5, -				reg, live); +    return gc_double_to_integer(p, round(f.fd), reg, live);  }  Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 19ce0f6965..4fa15a8dd8 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -690,7 +690,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,          Uint sz = size_object(msg);  	ErlOffHeap *ohp;          Eterm *hp; -	if (env && !env->tracee) { +	if (c_p && !env->tracee) {  	    full_flush_env(env);  	    mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);  	    full_cache_env(env); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 31396d06c6..9bf29ee230 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -4884,10 +4884,16 @@ erts_port_control(Process* c_p,  	ASSERT(!tmp_alloced);  	if (*ebinp == HEADER_SUB_BIN)  	    ebinp = binary_val(((ErlSubBin *) ebinp)->orig); +  	if (*ebinp != HEADER_PROC_BIN)  	    copy = 1;  	else { -	    binp = ((ProcBin *) ebinp)->val; +            ProcBin *pb = (ProcBin *) ebinp; + +            if (pb->flags) +                erts_emasculate_writable_binary(pb); + +	    binp = pb->val;  	    ASSERT(bufp <= bufp + size);  	    ASSERT(binp->orig_bytes <= bufp  		   && bufp + size <= binp->orig_bytes + binp->orig_size); diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index e155e5f49f..54ee710363 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -317,6 +317,7 @@ guard_bifs(Config) when is_list(Config) ->      try_gbif('float/1', Big, float(id(Big))),      try_gbif('trunc/1', Float, 387924.0),      try_gbif('round/1', Float, 387925.0), +    try_gbif('round/1', 6209607916799025.0, 6209607916799025),      try_gbif('length/1', [], 0),      try_gbif('length/1', [a], 1), diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index d1c9648017..bb85738454 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -293,6 +293,9 @@ t_round(Config) when is_list(Config) ->      4294967297 = round(id(4294967296.9)),      -4294967296 = -round(id(4294967296.1)),      -4294967297 = -round(id(4294967296.9)), + +    6209607916799025 = round(id(6209607916799025.0)), +    -6209607916799025 = round(id(-6209607916799025.0)),      ok.  t_trunc(Config) when is_list(Config) -> 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/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/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 991abb0666..16001ce4c8 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      | 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/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/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/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/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 37aa05e0fd..c97ec361d1 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -857,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> @@ -880,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/src/public_key.erl b/lib/public_key/src/public_key.erl index 402f514803..adc35073d6 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -893,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(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). -ssh_hostkey_fingerprint(HashAlg, Key) -> -    lists:concat([sshfp_alg_name(HashAlg), -		  [$: | sshfp_string(HashAlg, Key)] -		 ]). -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)). diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 615ff32539..68aa152911 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -54,7 +54,8 @@ all() ->       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() ->  @@ -93,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) -> @@ -600,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) ->  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/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_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_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/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 86f5cb1746..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,9 +828,10 @@ 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) -> @@ -840,7 +845,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->      %% 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 @@ -856,6 +861,9 @@ 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 @@ -866,8 +874,12 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->      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, 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_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 86c3d5de26..b6f4a7371d 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 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/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/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/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/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..2b9b37b5f3 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. @@ -442,6 +451,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 +1042,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 +1074,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 +1122,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 +1130,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) @@ -3290,7 +3318,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/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_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>  | 
