diff options
40 files changed, 1431 insertions, 318 deletions
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 8b772a011c..f2eda6c0f8 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -379,6 +379,16 @@ info(fmtfn_t to, void *to_arg) } +static int code_size(struct erl_module_instance* modi) +{ + ErtsLiteralArea* lit = modi->code_hdr->literal_area; + int size = modi->code_length; + if (lit) { + size += (lit->end - lit->start) * sizeof(Eterm); + } + return size; +} + void loaded(fmtfn_t to, void *to_arg) { @@ -399,9 +409,9 @@ loaded(fmtfn_t to, void *to_arg) if ((modp = module_code(i, code_ix)) != NULL && ((modp->curr.code_length != 0) || (modp->old.code_length != 0))) { - cur += modp->curr.code_length; + cur += code_size(&modp->curr); if (modp->old.code_length != 0) { - old += modp->old.code_length; + old += code_size(&modp->old); } } } @@ -422,12 +432,12 @@ loaded(fmtfn_t to, void *to_arg) ((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 ); + cur += code_size(&modp->curr); + erts_print(to, to_arg, " %d", code_size(&modp->curr)); if (modp->old.code_length != 0) { erts_print(to, to_arg, " (%d old)", - modp->old.code_length ); - old += modp->old.code_length; + code_size(&modp->old)); + old += code_size(&modp->old); } erts_print(to, to_arg, "\n"); } @@ -442,7 +452,7 @@ loaded(fmtfn_t to, void *to_arg) 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 +466,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_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 4327068b7b..313b7fc559 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -58,9 +58,11 @@ groups() -> || {Tag,Algs} <- ErlAlgos, lists:member(Tag,tags()) ], + + TypeSSH = ssh_test_lib:ssh_type(), AlgoTcSet = - [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos)} + [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos,TypeSSH)} || {Tag,Algs} <- ErlAlgos ++ DoubleAlgos, Alg <- Algs], @@ -313,18 +315,13 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])). split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")). -specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos) -> +specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) -> [simple_exec, simple_sftp] ++ case supports(Tag, Alg, SshcAlgos) of - true -> - case ssh_test_lib:ssh_type() of - openSSH -> - [sshc_simple_exec_os_cmd]; - _ -> - [] - end; - false -> - [] + true when TypeSSH == openSSH -> + [sshc_simple_exec_os_cmd]; + _ -> + [] end ++ case supports(Tag, Alg, SshdAlgos) of true -> diff --git a/lib/ssh/test/ssh_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/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/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 9f6b27113e..95dc82e5c9 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2309,7 +2309,9 @@ expanded_name(Name, [], #xmlNamespace{default = URI}, S) -> expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> {_, Value} = lists:keyfind(Local, 1, Ns), case Name of - 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> + 'xmlns:xml' when Value =:= 'http://www.w3.org/XML/1998/namespace' -> + N; + 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> ?fatal({xml_prefix_cannot_be_redeclared, Value}, S); 'xmlns:xmlns' -> ?fatal({xmlns_prefix_cannot_be_declared, Value}, S); @@ -2323,6 +2325,8 @@ expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> N end end; +expanded_name(_Name, {"xml", Local}, _NS, _S) -> + {'http://www.w3.org/XML/1998/namespace', list_to_atom(Local)}; expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> case lists:keysearch(Prefix, 1, Ns) of {value, {_, URI}} -> @@ -2333,9 +2337,6 @@ expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> ?fatal({namespace_prefix_not_declared, Prefix}, S) end. - - - keyreplaceadd(K, Pos, [H|T], Obj) when K == element(Pos, H) -> [Obj|T]; keyreplaceadd(K, Pos, [H|T], Obj) -> diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile index 7a326e334f..b13fee05b3 100644 --- a/lib/xmerl/test/Makefile +++ b/lib/xmerl/test/Makefile @@ -55,7 +55,8 @@ SUITE_FILES= \ xmerl_xsd_SUITE.erl \ xmerl_xsd_MS2002-01-16_SUITE.erl \ xmerl_xsd_NIST2002-01-16_SUITE.erl \ - xmerl_xsd_Sun2002-01-16_SUITE.erl + xmerl_xsd_Sun2002-01-16_SUITE.erl \ + xmerl_sax_stream_SUITE.erl XML_FILES= \ testcases.dtd \ @@ -125,4 +126,5 @@ release_tests_spec: opt @tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) @tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) @tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) chmod -R u+w "$(RELSYSDIR)" diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index cf7c0b7548..58c462483c 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -55,7 +55,7 @@ groups() -> {misc, [], [latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3, pe_ref1, copyright, testXSEIF, export_simple1, export, - default_attrs_bug]}, + default_attrs_bug, xml_ns]}, {eventp_tests, [], [sax_parse_and_export]}, {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, @@ -237,7 +237,36 @@ default_attrs_bug(Config) -> {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"}, #xmlAttribute{name = a, value = "explicit"}]}, [] - } = xmerl_scan:string(Doc2, [{default_attrs, true}]). + } = xmerl_scan:string(Doc2, [{default_attrs, true}]), + ok. + + +xml_ns(Config) -> + Doc = "<?xml version='1.0'?>\n" + "<doc xml:attr1=\"implicit xml ns\"/>", + {#xmlElement{namespace=#xmlNamespace{default = [], nodes = []}, + attributes = [#xmlAttribute{name = 'xml:attr1', + expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1}, + nsinfo = {"xml","attr1"}, + namespace = #xmlNamespace{default = [], nodes = []}}]}, + [] + } = xmerl_scan:string(Doc, [{namespace_conformant, true}]), + Doc2 = "<?xml version='1.0'?>\n" + "<doc xmlns:xml=\"http://www.w3.org/XML/1998/namespace\" xml:attr1=\"explicit xml ns\"/>", + {#xmlElement{namespace=#xmlNamespace{default = [], nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}, + attributes = [#xmlAttribute{name = 'xmlns:xml', + expanded_name = {"xmlns","xml"}, + nsinfo = {"xmlns","xml"}, + namespace = #xmlNamespace{default = [], + nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}, + #xmlAttribute{name = 'xml:attr1', + expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1}, + nsinfo = {"xml","attr1"}, + namespace = #xmlNamespace{default = [], + nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}]}, + [] + } = xmerl_scan:string(Doc2, [{namespace_conformant, true}]), + ok. pe_ref1(Config) -> file:set_cwd(datadir(Config)), 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> |