diff options
Diffstat (limited to 'lib')
101 files changed, 3490 insertions, 1936 deletions
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index bb445bb0d2..bd3755722f 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1425,7 +1425,12 @@ skip_groups1(Suite,Groups,Cmt,Suites0) -> GrAndCases1 = GrAndCases0 ++ SkipGroups, insert_in_order({Suite,GrAndCases1},Suites0,replace); false -> - insert_in_order({Suite,SkipGroups},Suites0,replace) + case Suites0 of + [{all,_}=All|Skips]-> + [All|Skips++[{Suite,SkipGroups}]]; + _ -> + insert_in_order({Suite,SkipGroups},Suites0,replace) + end end. skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,false) when is_list(Cases) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index c8abfa524f..fc2c7a991b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -914,10 +914,10 @@ merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> merge_type_info({tuple,Sz1,First}, Tuple2); merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> merge_type_info(Tuple1, {tuple,Sz2,First}); -merge_type_info(integer, {integer,_}=Int) -> - Int; -merge_type_info({integer,_}=Int, integer) -> - Int; +merge_type_info(integer, {integer,_}) -> + integer; +merge_type_info({integer,_}, integer) -> + integer; merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> {integer,{max(Min1, Min2),min(Max1, Max2)}}; merge_type_info(NewType, _) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 6219bc6894..ea38969814 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1329,7 +1329,12 @@ branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) Vst = branch_state(L, Vst1), branch_arities(T, Tuple, Vst#vst{current=St}). -branch_state(0, #vst{}=Vst) -> Vst; +branch_state(0, #vst{}=Vst) -> + %% If the instruction fails, the stack may be scanned + %% looking for a catch tag. Therefore the Y registers + %% must be initialized at this point. + verify_y_init(Vst), + Vst; branch_state(L, #vst{current=St,branched=B}=Vst) -> Vst#vst{ branched=case gb_trees:is_defined(L, B) of diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index fe856b12b6..d44fa60997 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -66,6 +66,15 @@ integers(_Config) -> college = do_integers_3(), + zero = do_integers_4(<<0:1>>, 0), + one = do_integers_4(<<1:1>>, 0), + other = do_integers_4(<<1:1>>, 2), + + zero = do_integers_5(0, 0), + one = do_integers_5(0, 1), + two = do_integers_5(0, 2), + three = do_integers_5(0, 3), + ok. do_integers_1(B0) -> @@ -88,6 +97,30 @@ do_integers_3() -> 1 -> 0 end. +do_integers_4(<<X:1,T/bits>>, C) -> + %% Binary matching gives the range 0-1 for X. + %% The range for `X bor C` is unknown. It must not be inherited + %% from X. (`X bor C` will reuse the register used for X.) + case X bor C of + 0 -> do_integers_4(T, C, zero); + 1 -> do_integers_4(T, C, one); + _ -> do_integers_4(T, C, other) + end. + +do_integers_4(_, _, Res) -> + Res. + +do_integers_5(X0, Y0) -> + %% X and Y will use the same register. + X = X0 band 1, + Y = Y0 band 3, + case Y of + 0 -> zero; + 1 -> one; + 2 -> two; + 3 -> three + end. + coverage(_Config) -> {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 8367432ac5..ea3523a965 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -1235,6 +1235,13 @@ handle_tuple(Tree, Map, State) -> State2 = state__add_warning(State1, ?WARN_OPAQUE, Tree, Msg), {State2, Map1, t_none()}; + {error, record, ErrorPat, ErrorType, _} -> + Msg = {record_match, + [format_patterns(ErrorPat), + format_type(ErrorType, State1)]}, + State2 = state__add_warning(State1, ?WARN_MATCHING, + Tree, Msg), + {State2, Map1, t_none()}; {Map2, ETypes} -> {State1, Map2, t_tuple(ETypes)} end @@ -3116,7 +3123,10 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, state__remove_added_warnings(OldState, NewState) -> #state{warnings = OldWarnings} = OldState, #state{warnings = NewWarnings} = NewState, - {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}}. + case NewWarnings =:= OldWarnings of + true -> {[], NewState}; + false -> {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}} + end. state__add_warnings(Warns, #state{warnings = Warnings} = State) -> State#state{warnings = Warns ++ Warnings}. @@ -3433,19 +3443,19 @@ state__fun_info(Fun, #state{callgraph = CG, fun_tab = FunTab, plt = PLT}) -> {Fun, Sig, Contract, LocalRet}. forward_args(Fun, ArgTypes, #state{work = Work, fun_tab = FunTab} = State) -> - {OldArgTypes, OldOut, Fixpoint} = + {NewArgTypes, OldOut, Fixpoint} = case dict:find(Fun, FunTab) of - {ok, {not_handled, {OldArgTypes0, OldOut0}}} -> - {OldArgTypes0, OldOut0, false}; + {ok, {not_handled, {_OldArgTypesAreNone, OldOut0}}} -> + {ArgTypes, OldOut0, false}; {ok, {OldArgTypes0, OldOut0}} -> - {OldArgTypes0, OldOut0, - t_is_subtype(t_product(ArgTypes), t_product(OldArgTypes0))} + NewArgTypes0 = [t_sup(X, Y) || + {X, Y} <- lists:zip(ArgTypes, OldArgTypes0)], + {NewArgTypes0, OldOut0, + t_is_equal(t_product(NewArgTypes0), t_product(OldArgTypes0))} end, case Fixpoint of true -> State; false -> - NewArgTypes = [t_sup(X, Y) || - {X, Y} <- lists:zip(ArgTypes, OldArgTypes)], NewWork = add_work(Fun, Work), ?debug("~tw: forwarding args ~ts\n", [state__lookup_name(Fun, State), diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same.erl new file mode 100644 index 0000000000..44149f4199 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same.erl @@ -0,0 +1,15 @@ +-module(same). + +-export([baz/1]). + +-record(bar, { + a :: same_type:st(integer()), + b :: same_type:st(atom()) + }). + +baz(Bar) -> + _ = wrap_find(0, Bar#bar.a), + wrap_find(0, Bar#bar.b). + +wrap_find(K, D) -> + same_type:t(K, D). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same_type.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same_type.erl new file mode 100644 index 0000000000..855a5d30be --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same_type.erl @@ -0,0 +1,13 @@ +-module(same_type). + +-export([t/2]). + +-export_type([st/1]). + +%% When unopaqued all specializations of st/1 are equal. +-opaque st(_A) :: {st, tuple()}. + +-spec t(_, st(_)) -> _. + +t(K, V) -> + {K, V}. diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_match b/lib/dialyzer/test/small_SUITE_data/results/record_match new file mode 100644 index 0000000000..a0dd6f560a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_match @@ -0,0 +1,3 @@ + +record_match.erl:16: Function select/0 has no local return +record_match.erl:17: Matching of pattern {'b_literal', 'undefined'} tagged with a record name violates the declared type of #b_local{} | #b_remote{} diff --git a/lib/dialyzer/test/small_SUITE_data/src/bsL.erl b/lib/dialyzer/test/small_SUITE_data/src/bsL.erl new file mode 100644 index 0000000000..b2fdc16324 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/bsL.erl @@ -0,0 +1,13 @@ +-module(bsL). + +-export([t/0]). + +%% Found in lib/observer/test/crashdump_helper.erl. + +t() -> + Size = 60, + <<H:16/unit:8>> = erlang:md5(<<Size:32>>), + true = H < 20, + true = H > 2, + Data = ((H bsl (8*150)) div (H+7919)), + <<Data:Size/unit:8>>. diff --git a/lib/dialyzer/test/small_SUITE_data/src/record_match.erl b/lib/dialyzer/test/small_SUITE_data/src/record_match.erl new file mode 100644 index 0000000000..8e9b91937f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_match.erl @@ -0,0 +1,17 @@ +-module(record_match). + +-export([select/0]). + +-record(b_literal, {val}). +-record(b_remote, {mod,name,arity}). +-record(b_local, {name,arity}). + +-type b_remote() :: #b_remote{}. +-type b_local() :: #b_local{}. + +-type argument() :: b_remote() | b_local(). + +-record(b_set, {args=[] :: [argument()]}). + +select() -> + #b_set{args=[#b_remote{},#b_literal{}]}. diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 2e56d25694..518f67ee1b 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1903,7 +1903,8 @@ infinity_div(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> infinity_bsl(pos_inf, _) -> pos_inf; infinity_bsl(neg_inf, _) -> neg_inf; -infinity_bsl(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf; +infinity_bsl(0, pos_inf) -> 0; +infinity_bsl(Number, pos_inf) when is_integer(Number), Number > 0 -> pos_inf; infinity_bsl(Number, pos_inf) when is_integer(Number) -> neg_inf; infinity_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0; infinity_bsl(Number, neg_inf) when is_integer(Number) -> -1; diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 4e0f93212d..2b290b2f23 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2351,6 +2351,8 @@ t_from_range(X, Y) -> -else. +t_from_range(pos_inf, pos_inf) -> ?integer_pos; +t_from_range(neg_inf, neg_inf) -> ?integer_neg; t_from_range(neg_inf, pos_inf) -> t_integer(); t_from_range(neg_inf, Y) when is_integer(Y), Y < 0 -> ?integer_neg; t_from_range(neg_inf, Y) when is_integer(Y), Y >= 0 -> t_integer(); @@ -2383,6 +2385,8 @@ t_from_range(pos_inf, neg_inf) -> t_none(). -spec t_from_range_unsafe(rng_elem(), rng_elem()) -> erl_type(). +t_from_range_unsafe(pos_inf, pos_inf) -> ?integer_pos; +t_from_range_unsafe(neg_inf, neg_inf) -> ?integer_neg; t_from_range_unsafe(neg_inf, pos_inf) -> t_integer(); t_from_range_unsafe(neg_inf, Y) -> ?int_range(neg_inf, Y); t_from_range_unsafe(X, pos_inf) -> ?int_range(X, pos_inf); diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl index 641d3fda0a..e04b171194 100644 --- a/lib/hipe/llvm/hipe_llvm.erl +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -934,7 +934,7 @@ pp_ins(Dev, Ver, I) -> end, case call_is_tail(I) of true -> write(Dev, "tail "); - false -> ok + false -> write(Dev, "notail ") end, write(Dev, ["call ", call_cconv(I), " "]), pp_options(Dev, call_ret_attrs(I)), diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 1482f4f922..a4e406b807 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -711,9 +711,9 @@ do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> %% can retry requests in the pipeline. do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. - + call(Msg, Pid) -> - try gen_server:call(Pid, Msg) + try gen_server:call(Pid, Msg, infinity) catch exit:{noproc, _} -> {error, closed}; diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index fdf4cc6e07..e24a4a8694 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,13 +18,13 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.4.3">>, [{load_module, httpd_esi, + {<<"6.4.5">>, [{load_module, httpc_handler, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.4.3">>, [{load_module, httpd_esi, + {<<"6.4.5">>, [{load_module, httpc_handler, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 2ad041cc0d..f7e5c11272 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -50,6 +50,7 @@ all() -> [ {group, http}, {group, sim_http}, + {group, http_internal}, {group, https}, {group, sim_https}, {group, misc} @@ -59,6 +60,7 @@ groups() -> [ {http, [], real_requests()}, {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]}, + {http_internal, [], real_requests_esi()}, {https, [], real_requests()}, {sim_https, [], only_simulated()}, {misc, [], misc()} @@ -93,6 +95,9 @@ real_requests()-> invalid_body ]. +real_requests_esi() -> + [slow_connection]. + only_simulated() -> [ cookie, @@ -1204,7 +1209,25 @@ stream_fun_server_close(Config) when is_list(Config) -> after 13000 -> ct:fail(did_not_receive_close) end. - + +%%-------------------------------------------------------------------- +slow_connection() -> + [{doc, "Test that a request on a slow keep-alive connection won't crash the httpc_manager"}]. +slow_connection(Config) when is_list(Config) -> + BodyFun = fun(0) -> eof; + (LenLeft) -> timer:sleep(1000), + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + Request = {url(group_name(Config), "/httpc_SUITE:esi_post", Config), + [{"content-length", "100"}], + "text/plain", + {BodyFun, 100}}, + {ok, _} = httpc:request(post, Request, [], []), + %% Second request causes a crash if gen_server timeout is not set to infinity + %% in httpc_handler. + {ok, _} = httpc:request(post, Request, [], []). + + %%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -1298,6 +1321,8 @@ url(https, End, Config) -> ?TLS_URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; url(sim_http, End, Config) -> url(http, End, Config); +url(http_internal, End, Config) -> + url(http, End, Config); url(sim_https, End, Config) -> url(https, End, Config). url(http, UserInfo, End, Config) -> @@ -1344,7 +1369,17 @@ server_config(http, Config) -> {mime_type, "text/plain"}, {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} ]; - +server_config(http_internal, Config) -> + ServerRoot = proplists:get_value(server_root, Config), + [{port, 0}, + {server_name,"httpc_test"}, + {server_root, ServerRoot}, + {document_root, proplists:get_value(doc_root, Config)}, + {bind_address, any}, + {ipfamily, inet_version()}, + {mime_type, "text/plain"}, + {erl_script_alias, {"", [httpc_SUITE]}} + ]; server_config(https, Config) -> [{socket_type, {essl, ssl_config(Config)}} | server_config(http, Config)]; server_config(sim_https, Config) -> @@ -1352,6 +1387,9 @@ server_config(sim_https, Config) -> server_config(_, _) -> []. +esi_post(Sid, _Env, _Input) -> + mod_esi:deliver(Sid, ["OK"]). + start_apps(https) -> inets_test_lib:start_apps([crypto, public_key, ssl]); start_apps(sim_https) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 05cf4f6cc3..dccdbfa94a 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.4.5 +INETS_VSN = 6.4.6 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index d7f224c38e..65fe9b9c07 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 5.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add <c>os:cmd/2</c> that takes an options map as the + second argument.</p> + <p> + Add <c>max_size</c> as an option to <c>os:cmd/2</c> that + control the maximum size of the result that + <c>os:cmd/2</c> will return.</p> + <p> + Own Id: OTP-14823</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 5.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 0e9add4161..7ce2f54542 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -38,17 +38,35 @@ most platforms.</p> </description> + <datatypes> + <datatype> + <name name="os_command"/> + </datatype> + <datatype> + <name name="os_command_opts"/> + <desc> + <p>Options for <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso></p> + <taglist> + <tag><c>max_size</c></tag> + <item> + <p>The maximum size of the data returned by the <c>os:cmd</c> call. + See the <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso> + documentation for more details.</p> + </item> + </taglist> + </desc> + </datatype> + </datatypes> + <funcs> <func> <name name="cmd" arity="1"/> + <name name="cmd" arity="2"/> <fsummary>Execute a command in a shell of the target OS.</fsummary> <desc> <p>Executes <c><anno>Command</anno></c> in a command shell of the - target OS, - captures the standard output of the command, and returns this - result as a string. This function is a replacement of - the previous function <c>unix:cmd/1</c>; they are equivalent on a - Unix platform.</p> + target OS, captures the standard output of the command, + and returns this result as a string.</p> <p><em>Examples:</em></p> <code type="none"> LsOut = os:cmd("ls"), % on unix platform @@ -57,6 +75,21 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> called from another program (for example, <c>os:cmd/1</c>) can differ, compared with the standard output of the command when called directly from an OS command shell.</p> + <p><c>os:cmd/2</c> was added in kernel-5.5 (OTP-20.2.1). It makes it + possible to pass an options map as the second argument in order to + control the behaviour of <c>os:cmd</c>. The possible options are: + </p> + <taglist> + <tag><c>max_size</c></tag> + <item> + <p>The maximum size of the data returned by the <c>os:cmd</c> call. + This option is a safety feature that should be used when the command + executed can return a very large, possibly infinite, result.</p> + <code type="none"> +> os:cmd("cat /dev/zero", #{ max_size => 20 }). +[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]</code> + </item> + </taglist> </desc> </func> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 418b0c50e1..f5a890cb95 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -340,8 +340,7 @@ handle_call(all_loaded, _From, S) -> {reply,all_loaded(Db),S}; handle_call({get_object_code,Mod}, _From, St) when is_atom(Mod) -> - Path = St#state.path, - case mod_to_bin(Path, Mod) of + case get_object_code(St, Mod) of {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; Error -> {reply,Error,St} end; @@ -1182,19 +1181,28 @@ load_file(Mod, From, St0) -> end, handle_pending_on_load(Action, Mod, From, St0). -load_file_1(Mod, From, #state{path=Path}=St) -> - case mod_to_bin(Path, Mod) of +load_file_1(Mod, From, St) -> + case get_object_code(St, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> try_load_module_1(File, Mod, Binary, From, St) end. -mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), +get_object_code(#state{path=Path}, Mod) when is_atom(Mod) -> + ModStr = atom_to_list(Mod), + case erl_prim_loader:is_basename(ModStr) of + true -> + mod_to_bin(Path, Mod, ModStr ++ objfile_extension()); + false -> + error + end. + +mod_to_bin([Dir|Tail], Mod, ModFile) -> + File = filename:append(Dir, ModFile), case erl_prim_loader:get_file(File) of error -> - mod_to_bin(Tail, Mod); + mod_to_bin(Tail, Mod, ModFile); {ok,Bin,_} -> case filename:pathtype(File) of absolute -> @@ -1203,10 +1211,9 @@ mod_to_bin([Dir|Tail], Mod) -> {Mod,Bin,absname(File)} end end; -mod_to_bin([], Mod) -> +mod_to_bin([], Mod, ModFile) -> %% At last, try also erl_prim_loader's own method - File = to_list(Mod) ++ objfile_extension(), - case erl_prim_loader:get_file(File) of + case erl_prim_loader:get_file(ModFile) of error -> error; % No more alternatives ! {ok,Bin,FName} -> diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 70cbf1c87c..99ea8dc384 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -266,7 +266,7 @@ inc_wrap_file(Log) -> Size :: dlog_size(), Reason :: no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} - | {new_size_too_small, CurrentSize :: pos_integer()} + | {new_size_too_small, Log, CurrentSize :: pos_integer()} | {badarg, size} | {file_error, file:filename(), file_error()}. change_size(Log, NewSize) -> diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index ac81cc9689..2578b74428 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -58,13 +58,11 @@ -define(single_addr_mask, {255, 255, 255, 255}). --type ip4_address() :: {0..255,0..255,0..255,0..255}. - --spec start(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start(Slaves) -> case check_arg(Slaves) of @@ -74,11 +72,11 @@ start(Slaves) -> {error, {badarg, Slaves}} end. --spec start_link(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start_link(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start_link(Slaves) -> case check_arg(Slaves) of @@ -104,10 +102,10 @@ check_arg([], Result) -> check_arg(_, _Result) -> error. --spec add_slave(Slave) -> 'ok' | {'error', What} when +-spec add_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. add_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -117,10 +115,10 @@ add_slave(Slave) -> {error, {badarg, Slave}} end. --spec delete_slave(Slave) -> 'ok' | {'error', What} when +-spec delete_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. delete_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -130,7 +128,7 @@ delete_slave(Slave) -> {error, {badarg, Slave}} end. --spec add_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> +-spec add_subnet(Netmask :: inet:ip_address(), Addr :: inet:ip_address()) -> 'ok' | {'error', any()}. add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> @@ -141,14 +139,15 @@ add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> {error, empty_subnet} end. --spec delete_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> 'ok'. +-spec delete_subnet(Netmask :: inet:ip_address(), + Addr :: inet:ip_address()) -> 'ok'. delete_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> gen_server:call(boot_server, {delete, {Mask, Addr}}). -spec which_slaves() -> Slaves when - Slaves :: [Host], - Host :: atom(). + Slaves :: [Slave], + Slave :: {Netmask :: inet:ip_address(), Address :: inet:ip_address()}. which_slaves() -> gen_server:call(boot_server, which). diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index 91f3663cc5..9745848992 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017. All Rights Reserved. +%% Copyright Ericsson AB 2017-2018. 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. @@ -260,7 +260,7 @@ resize_log(Name, _OldSize, NewSize) -> ok -> show('$#erlang-history-resize-result', "ok~n", []); - {error, {new_size_too_small, _}} -> + {error, {new_size_too_small, _, _}} -> show('$#erlang-history-resize-result', "failed (new size is too small)~n", []), disable_history(); diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index f4c7c277ed..f8199fcf71 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -236,9 +236,10 @@ load_common(Mod, Bin, Beam, Architecture) -> lists:foreach(fun({FE, DestAddress}) -> hipe_bifs:set_native_address_in_fe(FE, DestAddress) end, erase(closures_to_patch)), - ok = hipe_bifs:commit_patch_load(LoaderState), set_beam_call_traps(FunDefs), - ok; + export_funs(FunDefs), + ok = hipe_bifs:commit_patch_load(LoaderState), + ok; BeamBinary when is_binary(BeamBinary) -> %% Find all closures in the code. [] = erase(closures_to_patch), %Clean up, assertion. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 2a88cc7e26..0eca6fef03 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -120,6 +120,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-9.1", "stdlib-3.4", "sasl-3.0"]} + {runtime_dependencies, ["erts-9.3", "stdlib-3.4", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 0250783632..ae188ae932 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -21,7 +21,7 @@ %% Provides a common operating system interface. --export([type/0, version/0, cmd/1, find_executable/1, find_executable/2]). +-export([type/0, version/0, cmd/1, cmd/2, find_executable/1, find_executable/2]). -include("file.hrl"). @@ -32,6 +32,11 @@ putenv/2, set_signal/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). +-type os_command() :: atom() | io_lib:chars(). +-type os_command_opts() :: #{ max_size => non_neg_integer() | infinity }. + +-export_type([os_command/0, os_command_opts/0]). + -spec getenv() -> [string()]. getenv() -> erlang:nif_error(undef). @@ -232,15 +237,21 @@ extensions() -> %% Executes the given command in the default shell for the operating system. -spec cmd(Command) -> string() when - Command :: atom() | io_lib:chars(). + Command :: os_command(). cmd(Cmd) -> + cmd(Cmd, #{ }). + +-spec cmd(Command, Options) -> string() when + Command :: os_command(), + Options :: os_command_opts(). +cmd(Cmd, Opts) -> validate(Cmd), {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), Cmd), Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, stream, in, hide | SpawnOpts]), MonRef = erlang:monitor(port, Port), true = port_command(Port, SpawnInput), - Bytes = get_data(Port, MonRef, Eot, []), + Bytes = get_data(Port, MonRef, Eot, [], 0, maps:get(max_size, Opts, infinity)), demonitor(MonRef, [flush]), String = unicode:characters_to_list(Bytes), if %% Convert to unicode list if possible otherwise return bytes @@ -291,12 +302,13 @@ validate1([List|Rest]) when is_list(List) -> validate1([]) -> ok. -get_data(Port, MonRef, Eot, Sofar) -> +get_data(Port, MonRef, Eot, Sofar, Size, Max) -> receive {Port, {data, Bytes}} -> - case eot(Bytes, Eot) of + case eot(Bytes, Eot, Size, Max) of more -> - get_data(Port, MonRef, Eot, [Sofar,Bytes]); + get_data(Port, MonRef, Eot, [Sofar, Bytes], + Size + byte_size(Bytes), Max); Last -> catch port_close(Port), flush_until_down(Port, MonRef), @@ -307,13 +319,16 @@ get_data(Port, MonRef, Eot, Sofar) -> iolist_to_binary(Sofar) end. -eot(_Bs, <<>>) -> +eot(_Bs, <<>>, _Size, _Max) -> more; -eot(Bs, Eot) -> +eot(Bs, Eot, Size, Max) -> case binary:match(Bs, Eot) of - nomatch -> more; - {Pos, _} -> - binary:part(Bs,{0, Pos}) + nomatch when Size + byte_size(Bs) < Max -> + more; + {Pos, _} when Size + Pos < Max -> + binary:part(Bs,{0, Pos}); + _ -> + binary:part(Bs,{0, Max - Size}) end. %% When port_close returns we know that all the diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index fe2fc778f2..12e2521939 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 0a7f73c344..0e7b7adc47 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -3470,8 +3470,8 @@ start_procs(Parent, N1, N2, N3, Config) -> Pid6 = rpc:call(N3, ?MODULE, start_proc3, [test4]), assert_pid(Pid6), yes = global:register_name(test1, Pid3), - yes = global:register_name(test2, Pid4, {global, notify_all_name}), - yes = global:register_name(test3, Pid5, {global, random_notify_name}), + yes = global:register_name(test2, Pid4, fun global:notify_all_name/3), + yes = global:register_name(test3, Pid5, fun global:random_notify_name/3), Resolve = fun(Name, Pid1, Pid2) -> Parent ! {resolve_called, Name, node()}, {Min, Max} = minmax(Pid1, Pid2), @@ -3546,7 +3546,7 @@ start_proc_basic(Name) -> end. init_proc_basic(Parent, Name) -> - X = global:register_name(Name, self(), {?MODULE, fix_basic_name}), + X = global:register_name(Name, self(), fun ?MODULE:fix_basic_name/3), Parent ! {self(),X}, loop(). @@ -3791,15 +3791,6 @@ stop() -> test_server:stop_node(Node) end, nodes()). -dbg_logs(Name) -> dbg_logs(Name, ?NODES). - -dbg_logs(Name, Nodes) -> - lists:foreach(fun(N) -> - F = lists:concat([Name, ".log.", N, ".txt"]), - ok = sys:log_to_file({global_name_server, N}, F) - end, Nodes). - - %% Tests that locally loaded nodes do not loose contact with other nodes. global_lost_nodes(Config) when is_list(Config) -> Timeout = 60, diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 53a9e168ef..079b9790f6 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -25,7 +25,8 @@ -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, find_executable/1, unix_comment_in_command/1, deep_list_command/1, large_output_command/1, background_command/0, background_command/1, - message_leak/1, close_stdin/0, close_stdin/1, perf_counter_api/1]). + message_leak/1, close_stdin/0, close_stdin/1, max_size_command/1, + perf_counter_api/1]). -include_lib("common_test/include/ct.hrl"). @@ -37,7 +38,7 @@ all() -> [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, find_executable, unix_comment_in_command, deep_list_command, large_output_command, background_command, message_leak, - close_stdin, perf_counter_api]. + close_stdin, max_size_command, perf_counter_api]. groups() -> []. @@ -312,6 +313,19 @@ close_stdin(Config) -> "-1" = os:cmd(Fds). +max_size_command(_Config) -> + + Res20 = os:cmd("cat /dev/zero", #{ max_size => 20 }), + 20 = length(Res20), + + Res0 = os:cmd("cat /dev/zero", #{ max_size => 0 }), + 0 = length(Res0), + + Res32768 = os:cmd("cat /dev/zero", #{ max_size => 32768 }), + 32768 = length(Res32768), + + ResHello = os:cmd("echo hello", #{ max_size => 20 }), + 6 = length(ResHello). %% Test that the os:perf_counter api works as expected perf_counter_api(_Config) -> diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 106bda01ca..91261e1d55 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 5.4.1 +KERNEL_VSN = 5.4.2 diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index d612e0a1c5..1c40afba46 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -572,7 +572,8 @@ change_accum(true, S0) -> S0#holder{accum=true}; change_accum(false, S0=#holder{info=Info}) -> self() ! refresh, - S0#holder{accum=lists:sort(array:to_list(Info))}. + Accum = [{Pid, Reds} || #etop_proc_info{pid=Pid, reds=Reds} <- array:to_list(Info)], + S0#holder{accum=lists:sort(Accum)}. handle_update_old(#etop_info{procinfo=ProcInfo0}, S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 854f338a89..5bc17e2aee 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -257,8 +257,6 @@ init_stack_page(Parent, Pid) -> [Pid, current_stacktrace]) of {current_stacktrace,RawBt} -> - observer_wx:try_rpc(node(Pid), erlang, process_info, - [Pid, current_stacktrace]), wxListCtrl:deleteAllItems(LCtrl), wx:foldl(fun({M, F, A, Info}, Row) -> _Item = wxListCtrl:insertItem(LCtrl, Row, ""), diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index e16f3cab6b..2e387f7e74 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -38,13 +38,13 @@ -define(ID_SYSTEM_TABLES, 406). -define(ID_TABLE_INFO, 407). -define(ID_SHOW_TABLE, 408). - --record(opt, {type=ets, - sys_hidden=true, - unread_hidden=true, - sort_key=2, - sort_incr=true - }). + +-record(opts, {type=ets, + sys_hidden=true, + unread_hidden=true}). + +-record(sort, {sort_incr=true, + sort_key=2}). -record(state, { @@ -52,9 +52,9 @@ grid, panel, node=node(), - opt=#opt{}, + opts=#opts{}, + holder, selected, - tabs, timer }). @@ -64,8 +64,18 @@ start_link(Notebook, Parent, Config) -> init([Notebook, Parent, Config]) -> Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), - Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, - Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style}]), + + Opts=#opts{type=maps:get(type, Config, ets), + sys_hidden=maps:get(sys_hidden, Config, true), + unread_hidden=maps:get(unread_hidden, Config, true)}, + + Style = ?wxLC_REPORT bor ?wxLC_VIRTUAL bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, + Self = self(), + Attrs = observer_lib:create_attrs(), + Holder = spawn_link(fun() -> init_table_holder(Self, Attrs) end), + CBs = [{onGetItemText, fun(_, Item,Col) -> get_row(Holder, Item, Col) end}, + {onGetItemAttr, fun(_, Item) -> get_attr(Holder, Item) end}], + Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style} | CBs]), wxSizer:add(Sizer, Grid, [{flag, ?wxEXPAND bor ?wxALL}, {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Sizer), @@ -95,38 +105,26 @@ init([Notebook, Parent, Config]) -> wxWindow:setFocus(Grid), {Panel, #state{grid=Grid, parent=Parent, panel=Panel, - timer=Config, - opt=#opt{type=maps:get(type, Config, ets), - sys_hidden=maps:get(sys_hidden, Config, true), - unread_hidden=maps:get(unread_hidden, Config, true)} - }}. + opts=Opts, timer=Config, holder=Holder}}. handle_event(#wx{id=?ID_REFRESH}, - State = #state{node=Node, grid=Grid, opt=Opt}) -> - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder, node=Node, opts=Opts}) -> + Tables = get_tables(Node, Opts), + Holder ! {refresh, Tables}, + {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, - State = #state{node=Node, grid=Grid, - opt=Opt0=#opt{sort_key=Key, sort_incr=Bool}}) -> - Opt = case col2key(Col) of - Key -> Opt0#opt{sort_incr=not Bool}; - NewKey -> Opt0#opt{sort_key=NewKey} - end, - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder}) -> + Holder ! {sort, Col}, + {noreply, State}; -handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) +handle_event(#wx{id=Id}, State = #state{node=Node, holder=Holder, grid=Grid, opts=Opt0}) when Id >= ?ID_ETS, Id =< ?ID_SYSTEM_TABLES -> Opt = case Id of - ?ID_ETS -> Opt0#opt{type=ets}; - ?ID_MNESIA -> Opt0#opt{type=mnesia}; - ?ID_UNREADABLE -> Opt0#opt{unread_hidden= not Opt0#opt.unread_hidden}; - ?ID_SYSTEM_TABLES -> Opt0#opt{sys_hidden= not Opt0#opt.sys_hidden} + ?ID_ETS -> Opt0#opts{type=ets}; + ?ID_MNESIA -> Opt0#opts{type=mnesia}; + ?ID_UNREADABLE -> Opt0#opts{unread_hidden= not Opt0#opts.unread_hidden}; + ?ID_SYSTEM_TABLES -> Opt0#opts{sys_hidden= not Opt0#opts.sys_hidden} end, case get_tables2(Node, Opt) of Error = {error, _} -> @@ -135,9 +133,9 @@ handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) self() ! Error, {noreply, State}; Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}} + {noreply, State#state{opts=Opt}} end; handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> @@ -146,19 +144,18 @@ handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Index}}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs}) -> - Table = lists:nth(Index+1, Tabs), - case Table#tab.protection of - private -> - self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + State=#state{holder=Holder, node=Node, opts=#opts{type=Type}, grid=Grid}) -> + case get_table(Holder, Index) of + #tab{protection=private} -> + self() ! {error, "Table has 'private' protection and can not be read"}; + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, State=#state{panel=Panel}) -> - Menu = wxMenu:new(), wxMenu:append(Menu, ?ID_TABLE_INFO, "Table info"), wxMenu:append(Menu, ?ID_SHOW_TABLE, "Show Table Content"), @@ -167,32 +164,33 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Index}}, - State) -> + State=#state{holder=Holder}) -> + Holder ! {selected, Index}, {noreply, State#state{selected=Index}}; handle_event(#wx{id=?ID_TABLE_INFO}, - State = #state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State = #state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), + Table = get_table(Holder, Sel), display_table_info(Grid, Node, Type, Table), {noreply, State} end; handle_event(#wx{id=?ID_SHOW_TABLE}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State=#state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), - case Table#tab.protection of - private -> + case get_table(Holder, R) of + #tab{protection=private} -> self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State} end; @@ -202,14 +200,14 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; -handle_event(Event, _State) -> - error({unhandled_event, Event}). +handle_event(_Event, State) -> + {noreply, State}. handle_sync_event(_Event, _Obj, _State) -> ok. -handle_call(get_config, _, #state{timer=Timer, opt=Opt}=State) -> - #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, +handle_call(get_config, _, #state{timer=Timer, opts=Opt}=State) -> + #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, Conf0 = observer_lib:timer_config(Timer), Conf = Conf0#{type=>Type, sys_hidden=>Sys, unread_hidden=>Unread}, {reply, Conf, State}; @@ -220,50 +218,68 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). -handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, - tabs=OldTabs}) -> - case get_tables(Node, Opt) of - OldTabs -> - %% no change - {noreply, State}; - Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}} - end; +handle_info(refresh_interval, State = #state{holder=Holder, node=Node, opts=Opt}) -> + Tables = get_tables(Node, Opt), + Holder ! {refresh, Tables}, + {noreply, State}; -handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0, - timer=Timer0}) -> - {Tables, Opt} = case Opt0#opt.type =:= mnesia andalso get_tables2(Node, Opt0) of +handle_info({active, Node}, State = #state{parent=Parent, holder=Holder, grid=Grid, + opts=Opt0, timer=Timer0}) -> + {Tables, Opt} = case Opt0#opts.type =:= mnesia andalso get_tables2(Node, Opt0) of Ts when is_list(Ts) -> {Ts, Opt0}; _ -> % false or error getting mnesia tables - Opt1 = Opt0#opt{type=ets}, + Opt1 = Opt0#opts{type=ets}, {get_tables(Node, Opt1), Opt1} end, - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), create_menus(Parent, Opt), Timer = observer_lib:start_timer(Timer0, 10), - {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt, selected=Sel}}; + {noreply, State#state{node=Node, timer=Timer, opts=Opt}}; handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> +handle_info({error, Error}, #state{panel=Panel,opts=Opt}=State) -> Str = io_lib:format("ERROR: ~ts~n",[Error]), observer_lib:display_info_dialog(Panel,Str), - case Opt#opt.type of + case Opt#opts.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); _ -> ok end, - {noreply, State#state{opt=Opt#opt{type=ets}}}; + {noreply, State#state{opts=Opt#opts{type=ets}}}; + +handle_info({refresh, Min, Min}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Min+1), + wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0 + observer_wx:set_status(io_lib:format("Tables: ~w", [Min+1])), + {noreply, State}; +handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Max+1), + Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max), + observer_wx:set_status(io_lib:format("Tables: ~w", [Max+1])), + {noreply, State}; + +handle_info({selected, New, Size}, #state{grid=Grid, selected=Old} = State) -> + if + is_integer(Old), Old < Size -> + wxListCtrl:setItemState(Grid, Old, 0, ?wxLIST_STATE_SELECTED); + true -> ignore + end, + if is_integer(New) -> + wxListCtrl:setItemState(Grid, New, 16#FFFF, ?wxLIST_STATE_SELECTED), + wxListCtrl:ensureVisible(Grid, New); + true -> ignore + end, + {noreply, State#state{selected=New}}; handle_info(_Event, State) -> {noreply, State}. -terminate(_Event, _State) -> +terminate(_Event, #state{holder=Holder}) -> + Holder ! stop, ok. code_change(_, _, State) -> @@ -271,7 +287,7 @@ code_change(_, _, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create_menus(Parent, #opt{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> +create_menus(Parent, #opts{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> MenuEntries = [{"View", [#create_menu{id = ?ID_TABLE_INFO, text = "Table information\tCtrl-I"}, separator, @@ -298,7 +314,7 @@ get_tables(Node, Opts) -> Res -> Res end. -get_tables2(Node, #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> +get_tables2(Node, #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> Args = [Type, [{sys_hidden,Sys}, {unread_hidden,Unread}]], case rpc:call(Node, observer_backend, get_table_list, Args) of {badrpc, Error} -> @@ -386,49 +402,134 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -update_grid(Grid, Selected, Opt, Tables) -> - wx:batch(fun() -> update_grid2(Grid, Selected, Opt, Tables) end). - -update_grid2(Grid, {SelName,SelId}, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> - wxListCtrl:deleteAllItems(Grid), - Update = - fun(#tab{name = Name, id = Id, owner = Owner, size = Size, memory = Memory, - protection = Protection, reg_name = RegName}, - {Row, Sel}) -> - _Item = wxListCtrl:insertItem(Grid, Row, ""), - if (Row rem 2) =:= 0 -> - wxListCtrl:setItemBackgroundColour(Grid, Row, ?BG_EVEN); - true -> ignore - end, - if Protection == private -> - wxListCtrl:setItemTextColour(Grid, Row, {200,130,50}); - true -> ignore - end, - - lists:foreach(fun({_, ignore}) -> ignore; - ({Col, Val}) -> - wxListCtrl:setItem(Grid, Row, Col, observer_lib:to_str(Val)) - end, - [{0,Name}, {1,Size}, {2, Memory div 1024}, - {3,Owner}, {4,RegName}, {5,Id}]), - if SelName =:= Name, SelId =:= Id -> - wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED), - {Row+1, Row}; - true -> - wxListCtrl:setItemState(Grid, Row, 0, ?wxLIST_STATE_SELECTED), - {Row+1, Sel} - end - end, - ProcInfo = case Dir of - false -> lists:reverse(lists:keysort(Sort, Tables)); - true -> lists:keysort(Sort, Tables) - end, - {_, Sel} = lists:foldl(Update, {0, undefined}, ProcInfo), - {ProcInfo, Sel}. - -sel(#state{selected=Sel, tabs=Tabs}) -> - try lists:nth(Sel+1, Tabs) of - #tab{name=Name, id=Id} -> {Name, Id} - catch _:_ -> - {undefined, undefined} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Table holder needs to be in a separate process otherwise +%% the callback get_row/3 may deadlock if the process do +%% wx calls when callback is invoked. + +get_table(Table, Item) -> + get_row(Table, Item, all). + +get_row(Table, Item, Column) -> + Ref = erlang:monitor(process, Table), + Table ! {get_row, self(), Item, Column}, + receive + {'DOWN', Ref, _, _, _} -> ""; + {Table, Res} -> + erlang:demonitor(Ref), + Res end. + +get_attr(Table, Item) -> + Ref = erlang:monitor(process, Table), + Table ! {get_attr, self(), Item}, + receive + {'DOWN', Ref, _, _, _} -> wx:null(); + {Table, Res} -> + erlang:demonitor(Ref), + Res + end. + +-record(holder, {node, parent, pid, + tabs=array:new(), + sort=#sort{}, + attrs, + sel + }). + +init_table_holder(Parent, Attrs) -> + Parent ! refresh, + table_holder(#holder{node=node(), parent=Parent, attrs=Attrs}). + +table_holder(S0 = #holder{parent=Parent, tabs=Tabs0, sel=Sel0}) -> + receive + {get_attr, From, Row} -> + get_attr(From, Row, S0), + table_holder(S0); + {get_row, From, Row, Col} -> + get_row(From, Row, Col, Tabs0), + table_holder(S0); + {sort, Col} -> + STab = get_sel(Sel0, Tabs0), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + S1 = sort(col2key(Col), S0), + Sel = sel_idx(STab, S1#holder.tabs), + Parent ! {selected, Sel, array:size(Tabs0)}, + table_holder(S1#holder{sel=Sel}); + {refresh, Tabs1} -> + STab = get_sel(Sel0, Tabs0), + Tabs = case S0#holder.sort of + #sort{sort_incr=false, sort_key=Col} -> + array:from_list(lists:reverse(lists:keysort(Col, Tabs1))); + #sort{sort_key=Col} -> + array:from_list(lists:keysort(Col, Tabs1)) + end, + Parent ! {refresh, 0, array:size(Tabs)-1}, + Sel = sel_idx(STab, Tabs), + Parent ! {selected, Sel,array:size(Tabs)}, + table_holder(S0#holder{tabs=Tabs, sel=Sel}); + {selected, Sel} -> + table_holder(S0#holder{sel=Sel}); + stop -> + ok; + What -> + io:format("Table holder got ~tp~n",[What]), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + table_holder(S0) + end. + +get_sel(undefined, _Tabs) -> + undefined; +get_sel(Idx, Tabs) -> + array:get(Idx, Tabs). + +sel_idx(undefined, _Tabs) -> + undefined; +sel_idx(Tab, Tabs) -> + Find = fun(Idx, C, Acc) -> C =:= Tab andalso throw({found, Idx}), Acc end, + try array:foldl(Find, undefined, Tabs) + catch {found, Idx} -> Idx + end. + +sort(Col, #holder{sort=#sort{sort_key=Col, sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = lists:reverse(array:to_list(Table0)), + H#holder{sort=S#sort{sort_incr=(not Incr)}, + tabs=array:from_list(Table)}; +sort(Col, #holder{sort=#sort{sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = case Incr of + false -> lists:reverse(lists:keysort(Col, array:to_list(Table0))); + true -> lists:keysort(Col, array:to_list(Table0)) + end, + H#holder{sort=S#sort{sort_key=Col}, + tabs=array:from_list(Table)}. + +get_row(From, Row, Col, Table) -> + Object = array:get(Row, Table), + From ! {self(), get_col(Col, Object)}. + +get_col(all, Rec) -> + Rec; +get_col(2, #tab{}=Rec) -> %% Memory in kB + observer_lib:to_str(element(#tab.memory, Rec) div 1024); +get_col(Col, #tab{}=Rec) -> + case element(col2key(Col), Rec) of + ignore -> ""; + Val -> observer_lib:to_str(Val) + end; +get_col(_, _) -> + "". + +get_attr(From, Row, #holder{tabs=Tabs, attrs=Attrs}) -> + EvenOdd = case (Row rem 2) > 0 of + true -> Attrs#attrs.odd; + false -> Attrs#attrs.even + end, + What = try array:get(Row, Tabs) of + #tab{protection=private} -> + Attrs#attrs.deleted; + _ -> + EvenOdd + catch _ -> + EvenOdd + end, + From ! {self(), What}. diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 0db2c1ea77..fd4f93f662 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -113,7 +113,12 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> - timer:send_after(100, "foobar"), %% Otherwise the timer server gets added to procs + %% Start these before + wx:new(), + wx:destroy(), + timer:send_after(100, "foobar"), + {foo, node@machine} ! dummy_msg, %% start distribution stuff + %% Otherwise ever lasting servers gets added to procs ProcsBefore = processes(), ProcInfoBefore = [{P,process_info(P)} || P <- ProcsBefore], NumProcsBefore = length(ProcsBefore), diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 93e3e26fda..74300ba3fc 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.12.4</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New family of <c>erts_alloc</c> strategies: Age Order + First Fit. Similar to "address order", but instead the + oldest possible carrier is always chosen for allocation.</p> + <p> + Own Id: OTP-14917 Aux Id: ERIERL-88 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.12.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 514530332c..4b028681a0 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -265,7 +265,13 @@ strategy_str(aoff) -> strategy_str(aoffcbf) -> "Address order first fit carrier best fit"; strategy_str(aoffcaobf) -> - "Address order first fit carrier adress order best fit". + "Address order first fit carrier adress order best fit"; +strategy_str(ageffcaoff) -> + "Age order first fit carrier address order first fit"; +strategy_str(ageffcbf) -> + "Age order first fit carrier best fit"; +strategy_str(ageffcaobf) -> + "Age order first fit carrier adress order best fit". default_acul(A, S) -> case carrier_migration_support(S) of diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 6a9f3ff58a..3772fcd2f9 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -488,10 +488,10 @@ to_fd(Fd) -> ok = file:write(Fd, io_lib:format(Format, Args)) end, - EmitChunk("{system_information_version, ~p}.~n" + EmitChunk("{system_information_version, ~w}.~n" "{system_information,[" - "{init_arguments,~p}," - "{code_paths,~p},", + "{init_arguments,~w}," + "{code_paths,~w},", [?REPORT_FILE_VSN, init:get_arguments(), code:get_path()]), @@ -499,12 +499,12 @@ to_fd(Fd) -> emit_code_info(EmitChunk), EmitChunk( "," %% Note the leading comma! - "{system_info,~p}," - "{erts_compile_info,~p}," - "{beam_dynamic_libraries,~p}," - "{environment_erts,~p}," - "{environment,~p}," - "{sanity_check,~p}" + "{system_info,~w}," + "{erts_compile_info,~w}," + "{beam_dynamic_libraries,~w}," + "{environment_erts,~w}," + "{environment,~w}," + "{sanity_check,~w}" "]}.~n", [erlang_system_info(), erlang:system_info(compile_info), @@ -533,11 +533,11 @@ emit_application_info(EmitChunk, Path) -> Description = proplists:get_value(description, Info, []), Version = proplists:get_value(vsn, Info, []), - EmitChunk("{application, {~p,[" - "{description,~p}," - "{vsn,~p}," - "{path,~p}," - "{runtime_dependencies,~p},", + EmitChunk("{application, {~w,[" + "{description,~w}," + "{vsn,~w}," + "{path,~w}," + "{runtime_dependencies,~w},", [App, Description, Version, Path, RtDeps]), emit_module_info_from_path(EmitChunk, Path), EmitChunk("]}}", []) @@ -545,7 +545,7 @@ emit_application_info(EmitChunk, Path) -> emit_code_path_info(EmitChunk, Path) -> EmitChunk("{code, [" - "{path, ~p},", [Path]), + "{path, ~w},", [Path]), emit_module_info_from_path(EmitChunk, Path), EmitChunk("]}", []). @@ -573,11 +573,11 @@ emit_module_info(EmitChunk, Beam) -> _ -> true end, - EmitChunk("{~p,[" - "{loaded,~p}," - "{native,~p}," - "{compiler,~p}," - "{md5,~p}" + EmitChunk("{~w,[" + "{loaded,~w}," + "{native,~w}," + "{compiler,~w}," + "{md5,~w}" "]}", [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]). diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index 872bd5db1d..0dc6a48570 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.12.3 +RUNTIME_TOOLS_VSN = 1.12.4 diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 3a2f55a487..c559da911b 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,42 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.6.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Adjusted supervisor timeouts</p> + <p> + Own Id: OTP-14907</p> + </item> + <item> + <p> + Remove ERROR messages for slow process exits</p> + <p> + Own Id: OTP-14930</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add option <c>save_accepted_host</c> to + <c>ssh:connection</c>. This option, if set to false, + inhibits saving host keys to e.g the file + <c>known_hosts</c>.</p> + <p> + Own Id: OTP-14935</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 337f4094cc..acf94ff6af 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -227,6 +227,18 @@ </item> </list> </item> + + <tag><c><![CDATA[{save_accepted_host, boolean()}]]></c></tag> + <item> + <p>If <c>true</c>, the client saves an accepted host key to avoid the + accept question the next time the same host is connected. If the option + <c>key_cb</c> is not present, the key is saved in the file "known_hosts". + </p> + <p>If <c>false</c>, the key is not saved and the key will still be unknown + at the next access of the same host. + </p> + </item> + <tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag> <item> <p>If <c>false</c>, disables the client to connect to the server diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index a24664793b..fc564a359b 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -86,10 +86,7 @@ child_spec(Address, Port, Profile, Options) -> Timeout = ?GET_INTERNAL_OPT(timeout, Options, ?DEFAULT_TIMEOUT), #{id => id(Address, Port, Profile), start => {ssh_acceptor, start_link, [Port, Address, Options, Timeout]}, - restart => transient, - shutdown => 5500, %brutal_kill, - type => worker, - modules => [ssh_acceptor] + restart => transient % because a crashed listener could be replaced by a new one }. id(Address, Port, Profile) -> diff --git a/lib/ssh/src/ssh_channel_sup.erl b/lib/ssh/src/ssh_channel_sup.erl index 6b01dc334d..8444533fd1 100644 --- a/lib/ssh/src/ssh_channel_sup.erl +++ b/lib/ssh/src/ssh_channel_sup.erl @@ -26,7 +26,7 @@ -behaviour(supervisor). --export([start_link/1, start_child/2]). +-export([start_link/1, start_child/5]). %% Supervisor callback -export([init/1]). @@ -37,7 +37,14 @@ start_link(Args) -> supervisor:start_link(?MODULE, [Args]). -start_child(Sup, ChildSpec) -> +start_child(Sup, Callback, Id, Args, Exec) -> + ChildSpec = + #{id => make_ref(), + start => {ssh_channel, start_link, [self(), Id, Callback, Args, Exec]}, + restart => temporary, + type => worker, + modules => [ssh_channel] + }, supervisor:start_child(Sup, ChildSpec). %%%========================================================================= diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 7e9ee78fd2..946ae2967b 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -812,22 +812,20 @@ start_channel(Cb, Id, Args, SubSysSup, Opts) -> start_channel(Cb, Id, Args, SubSysSup, undefined, Opts). start_channel(Cb, Id, Args, SubSysSup, Exec, Opts) -> - ChildSpec = child_spec(Cb, Id, Args, Exec), ChannelSup = ssh_subsystem_sup:channel_supervisor(SubSysSup), - assert_limit_num_channels_not_exceeded(ChannelSup, Opts), - ssh_channel_sup:start_child(ChannelSup, ChildSpec). + case max_num_channels_not_exceeded(ChannelSup, Opts) of + true -> + ssh_channel_sup:start_child(ChannelSup, Cb, Id, Args, Exec); + false -> + throw(max_num_channels_exceeded) + end. -assert_limit_num_channels_not_exceeded(ChannelSup, Opts) -> +max_num_channels_not_exceeded(ChannelSup, Opts) -> MaxNumChannels = ?GET_OPT(max_channels, Opts), NumChannels = length([x || {_,_,worker,[ssh_channel]} <- supervisor:which_children(ChannelSup)]), - if - %% Note that NumChannels is BEFORE starting a new one - NumChannels < MaxNumChannels -> - ok; - true -> - throw(max_num_channels_exceeded) - end. + %% Note that NumChannels is BEFORE starting a new one + NumChannels < MaxNumChannels. %%-------------------------------------------------------------------- %%% Internal functions @@ -874,14 +872,6 @@ check_subsystem(SsName, Options) -> Value end. -child_spec(Callback, Id, Args, Exec) -> - Name = make_ref(), - StartFunc = {ssh_channel, start_link, [self(), Id, Callback, Args, Exec]}, - Restart = temporary, - Shutdown = 3600, - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, [ssh_channel]}. - start_cli(#connection{cli_spec = no_cli}, _) -> {error, cli_disabled}; start_cli(#connection{options = Options, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 0ca960ef96..c8ac3a9c04 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1460,13 +1460,12 @@ terminate(shutdown, StateName, State0) -> State0), finalize_termination(StateName, State); -%% terminate({shutdown,Msg}, StateName, State0) when is_record(Msg,ssh_msg_disconnect)-> -%% State = send_msg(Msg, State0), -%% finalize_termination(StateName, Msg, State); - terminate({shutdown,_R}, StateName, State) -> finalize_termination(StateName, State); +terminate(kill, StateName, State) -> + finalize_termination(StateName, State); + terminate(Reason, StateName, State0) -> %% Others, e.g undef, {badmatch,_} log_error(Reason), diff --git a/lib/ssh/src/ssh_connection_sup.erl b/lib/ssh/src/ssh_connection_sup.erl index 60ee8b7c73..2e8450090a 100644 --- a/lib/ssh/src/ssh_connection_sup.erl +++ b/lib/ssh/src/ssh_connection_sup.erl @@ -52,10 +52,7 @@ init(_) -> }, ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. start => {ssh_connection_handler, start_link, []}, - restart => temporary, - shutdown => 4000, - type => worker, - modules => [ssh_connection_handler] + restart => temporary % because there is no way to restart a crashed connection } ], {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 68c99743ee..cf1534bd78 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -439,6 +439,12 @@ default(client) -> class => user_options }, + {save_accepted_host, def} => + #{default => true, + chk => fun erlang:is_boolean/1, + class => user_options + }, + {pref_public_key_algs, def} => #{default => ssh_transport:default_algorithms(public_key), chk => fun check_pref_public_key_algs/1, diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl index 8db051095c..77da240a66 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_subsystem_sup.erl @@ -74,18 +74,14 @@ ssh_connection_child_spec(Role, Address, Port, _Profile, Options) -> #{id => id(Role, ssh_connection_sup, Address, Port), start => {ssh_connection_sup, start_link, [Options]}, restart => temporary, - shutdown => 5000, - type => supervisor, - modules => [ssh_connection_sup] + type => supervisor }. ssh_channel_child_spec(Role, Address, Port, _Profile, Options) -> #{id => id(Role, ssh_channel_sup, Address, Port), start => {ssh_channel_sup, start_link, [Options]}, restart => temporary, - shutdown => infinity, - type => supervisor, - modules => [ssh_channel_sup] + type => supervisor }. id(Role, Sup, Address, Port) -> diff --git a/lib/ssh/src/ssh_sup.erl b/lib/ssh/src/ssh_sup.erl index eaec7a54e4..8183016ba5 100644 --- a/lib/ssh/src/ssh_sup.erl +++ b/lib/ssh/src/ssh_sup.erl @@ -36,15 +36,14 @@ init(_) -> intensity => 10, period => 3600 }, - ChildSpecs = [#{id => Module, - start => {Module, start_link, []}, - restart => permanent, - shutdown => 4000, %brutal_kill, - type => supervisor, - modules => [Module] + ChildSpecs = [#{id => sshd_sup, + start => {sshd_sup, start_link, []}, + type => supervisor + }, + #{id => sshc_sup, + start => {sshc_sup, start_link, []}, + type => supervisor } - || Module <- [sshd_sup, - sshc_sup] ], {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index e70abf59c2..17f990c5d8 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -63,9 +63,7 @@ init([Address, Port, Profile, Options]) -> [#{id => id(ssh_acceptor_sup, Address, Port, Profile), start => {ssh_acceptor_sup, start_link, [Address, Port, Profile, Options]}, restart => transient, - shutdown => infinity, - type => supervisor, - modules => [ssh_acceptor_sup] + type => supervisor }]; _ -> [] @@ -124,9 +122,8 @@ start_subsystem(SystemSup, Role, Address, Port, Profile, Options) -> #{id => make_ref(), start => {ssh_subsystem_sup, start_link, [Role, Address, Port, Profile, Options]}, restart => temporary, - shutdown => infinity, - type => supervisor, - modules => [ssh_subsystem_sup]}, + type => supervisor + }, supervisor:start_child(SystemSup, SubsystemSpec). stop_subsystem(SystemSup, SubSys) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index ad9efc4755..975053d301 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -889,10 +889,13 @@ known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_} {_,true} -> ok; {_,false} -> + DoAdd = ?GET_OPT(save_accepted_host, Opts), case accepted_host(Ssh, PeerName, Public, Opts) of - true -> + true when DoAdd == true -> {_,R} = add_host_key(KeyCb, PeerName, Public, [{key_cb_private,KeyCbOpts}|UserOpts]), R; + true when DoAdd == false -> + ok; false -> {error, rejected_by_user}; {error,E} -> diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 133b2c6450..fd4d8a3c07 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -60,10 +60,7 @@ init(_) -> }, ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. start => {ssh_connection_handler, start_link, []}, - restart => temporary, - shutdown => 4000, - type => worker, - modules => [ssh_connection_handler] + restart => temporary % because there is no way to restart a crashed connection } ], {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index c23e65d955..779a861a54 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -90,10 +90,8 @@ init(_) -> child_spec(Address, Port, Profile, Options) -> #{id => id(Address, Port, Profile), start => {ssh_system_sup, start_link, [Address, Port, Profile, Options]}, - restart => temporary, - shutdown => infinity, - type => supervisor, - modules => [ssh_system_sup] + restart => temporary, + type => supervisor }. id(Address, Port, Profile) -> diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index 74ab5aca3a..82b83dd83d 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -32,7 +32,8 @@ -compile(export_all). -define(USER,"sshtester"). --define(PWD, "foobar"). +-define(PASSWD, "foobar"). +-define(BAD_PASSWD, "NOT-"?PASSWD). -define(DOCKER_PFX, "ssh_compat_suite-ssh"). %%-------------------------------------------------------------------- @@ -44,25 +45,22 @@ suite() -> {timetrap,{seconds,40}}]. all() -> - [{group,G} || G <- vers()]. +%% [check_docker_present] ++ + [{group,G} || G <- ssh_image_versions()]. groups() -> - [{G, [], tests()} || G <- vers()]. - -tests() -> - [login_with_password_otp_is_client, - login_with_password_otp_is_server, - login_with_keyboard_interactive_otp_is_client, - login_with_keyboard_interactive_otp_is_server, - login_with_all_public_keys_otp_is_client, - login_with_all_public_keys_otp_is_server, - all_algorithms_otp_is_client, - all_algorithms_otp_is_server + [{otp_client, [], [login_otp_is_client, + all_algorithms_sftp_exec_reneg_otp_is_client, + send_recv_big_with_renegotiate_otp_is_client + ]}, + {otp_server, [], [login_otp_is_server, + all_algorithms_sftp_exec_reneg_otp_is_server + ]} | + [{G, [], [{group,otp_client}, {group,otp_server}]} || G <- ssh_image_versions()] ]. - -vers() -> +ssh_image_versions() -> try %% Find all useful containers in such a way that undefined command, too low %% priviliges, no containers and containers found give meaningful result: @@ -97,25 +95,56 @@ end_per_suite(Config) -> Config. +init_per_group(otp_server, Config) -> + case proplists:get_value(common_remote_client_algs, Config) of + undefined -> + SSHver = proplists:get_value(ssh_version, Config, ""), + {skip,"No "++SSHver++ " client found in docker"}; + _ -> + Config + end; + +init_per_group(otp_client, Config) -> + Config; -init_per_group(G, Config) -> - case lists:member(G, vers()) of +init_per_group(G, Config0) -> + case lists:member(G, ssh_image_versions()) of true -> + %% This group is for one of the images + Vssh = atom_to_list(G), + Cmnt = io_lib:format("+++ ~s +++",[Vssh]), + ct:comment("~s",[Cmnt]), try start_docker(G) of {ok,ID} -> - ct:log("==> ~p",[G]), - [Vssh|VsslRest] = string:tokens(atom_to_list(G), "-"), - Vssl = lists:flatten(lists:join($-,VsslRest)), - ct:comment("+++ ~s + ~s +++",[Vssh,Vssl]), + ct:log("==> ~p started",[G]), %% Find the algorithms that both client and server supports: {IP,Port} = ip_port([{id,ID}]), - try common_algs([{id,ID}|Config], IP, Port) of - {ok, RemoteServerCommon, RemoteClientCommon} -> - [{ssh_version,Vssh},{ssl_version,Vssl}, - {id,ID}, - {common_server_algs,RemoteServerCommon}, - {common_client_algs,RemoteClientCommon} - |Config]; + ct:log("Try contact ~p:~p",[IP,Port]), + Config1 = [{id,ID}, + {ssh_version,Vssh} + | Config0], + try common_algs(Config1, IP, Port) of + {ok, ServerHello, RemoteServerCommon, ClientHello, RemoteClientCommon} -> + case chk_hellos([ServerHello,ClientHello], Cmnt) of + Cmnt -> + ok; + NewCmnt -> + ct:comment("~s",[NewCmnt]) + end, + AuthMethods = + %% This should be obtained by quering the peer, but that + %% is a bit hard. It is possible with ssh_protocol_SUITE + %% techniques, but it can wait. + case Vssh of + "dropbear" ++ _ -> + [password, publickey]; + _ -> + [password, 'keyboard-interactive', publickey] + end, + [{common_remote_server_algs,RemoteServerCommon}, + {common_remote_client_algs,RemoteClientCommon}, + {common_authmethods,AuthMethods} + |Config1]; Other -> ct:log("Error in init_per_group: ~p",[Other]), stop_docker(ID), @@ -138,188 +167,301 @@ init_per_group(G, Config) -> end; false -> - Config + Config0 end. -end_per_group(_, Config) -> - catch stop_docker(proplists:get_value(id,Config)), - Config. +end_per_group(G, Config) -> + case lists:member(G, ssh_image_versions()) of + true -> + catch stop_docker(proplists:get_value(id,Config)); + false -> + ok + end. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -login_with_password_otp_is_client(Config) -> - {IP,Port} = ip_port(Config), - {ok,C} = ssh:connect(IP, Port, [{auth_methods,"password"}, - {user,?USER}, - {password,?PWD}, - {user_dir, new_dir(Config)}, - {silently_accept_hosts,true}, - {user_interaction,false} - ]), - ssh:close(C). - -%%-------------------------------------------------------------------- -login_with_password_otp_is_server(Config) -> - {Server, Host, HostPort} = - ssh_test_lib:daemon(0, - [{auth_methods,"password"}, - {system_dir, setup_local_hostdir('ssh-rsa',Config)}, - {user_dir, new_dir(Config)}, - {user_passwords, [{?USER,?PWD}]}, - {failfun, fun ssh_test_lib:failfun/2} - ]), - R = exec_from_docker(Config, Host, HostPort, - "'lists:concat([\"Answer=\",1+2]).\r\n'", - [<<"Answer=3">>], - ""), - ssh:stop_daemon(Server), - R. - -%%-------------------------------------------------------------------- -login_with_keyboard_interactive_otp_is_client(Config) -> - {DockerIP,DockerPort} = ip_port(Config), - {ok,C} = ssh:connect(DockerIP, DockerPort, - [{auth_methods,"keyboard-interactive"}, - {user,?USER}, - {password,?PWD}, - {user_dir, new_dir(Config)}, - {silently_accept_hosts,true}, - {user_interaction,false} - ]), - ssh:close(C). - -%%-------------------------------------------------------------------- -login_with_keyboard_interactive_otp_is_server(Config) -> - {Server, Host, HostPort} = - ssh_test_lib:daemon(0, - [{auth_methods,"keyboard-interactive"}, - {system_dir, setup_local_hostdir('ssh-rsa',Config)}, - {user_dir, new_dir(Config)}, - {user_passwords, [{?USER,?PWD}]}, - {failfun, fun ssh_test_lib:failfun/2} - ]), - R = exec_from_docker(Config, Host, HostPort, - "'lists:concat([\"Answer=\",1+3]).\r\n'", - [<<"Answer=4">>], - ""), - ssh:stop_daemon(Server), - R. +check_docker_present(_Config) -> + ct:log("This testcase is just to show in Monitor that we have a test host with docker installed",[]), + {fail, "Test is OK: just showing docker is available"}. %%-------------------------------------------------------------------- -login_with_all_public_keys_otp_is_client(Config) -> - CommonAlgs = [{public_key_from_host,A} - || {public_key,A} <- proplists:get_value(common_server_algs, Config)], - {DockerIP,DockerPort} = ip_port(Config), - chk_all_algos(CommonAlgs, Config, - fun(_Tag,Alg) -> - ssh:connect(DockerIP, DockerPort, - [{auth_methods, "publickey"}, - {user, ?USER}, - {user_dir, setup_remote_auth_keys_and_local_priv(Alg, Config)}, - {silently_accept_hosts,true}, - {user_interaction,false} - ]) +login_otp_is_client(Config) -> + {IP,Port} = ip_port(Config), + PublicKeyAlgs = [A || {public_key,A} <- proplists:get_value(common_remote_server_algs, Config)], + CommonAuths = + [{AuthMethod,Alg} || AuthMethod <- proplists:get_value(common_authmethods, Config), + Alg <- case AuthMethod of + publickey -> + PublicKeyAlgs; + _ -> + [' '] + end + ], + + chk_all_algos(?FUNCTION_NAME, CommonAuths, Config, + fun(AuthMethod,Alg) -> + {Opts,Dir} = + case AuthMethod of + publickey -> + {[], setup_remote_auth_keys_and_local_priv(Alg, Config)}; + _ -> + {[{password,?PASSWD}], new_dir(Config)} + end, + ssh:connect(IP, Port, [{auth_methods, atom_to_list(AuthMethod)}, + {user,?USER}, + {user_dir, Dir}, + {silently_accept_hosts,true}, + {user_interaction,false} + | Opts + ]) end). + %%-------------------------------------------------------------------- -login_with_all_public_keys_otp_is_server(Config) -> - CommonAlgs = [{public_key_to_host,A} - || {public_key,A} <- proplists:get_value(common_client_algs, Config)], - UserDir = new_dir(Config), - {Server, Host, HostPort} = - ssh_test_lib:daemon(0, - [{auth_methods, "publickey"}, - {system_dir, setup_local_hostdir('ssh-rsa',Config)}, - {user_dir, UserDir}, - {user_passwords, [{?USER,?PWD}]}, - {failfun, fun ssh_test_lib:failfun/2} - ]), - - R = chk_all_algos(CommonAlgs, Config, - fun(_Tag,Alg) -> - setup_remote_priv_and_local_auth_keys(Alg, clear_dir(UserDir), Config), - exec_from_docker(Config, Host, HostPort, - "'lists:concat([\"Answer=\",1+4]).\r\n'", - [<<"Answer=5">>], - "") - end), - ssh:stop_daemon(Server), - R. +login_otp_is_server(Config) -> + PublicKeyAlgs = [A || {public_key,A} <- proplists:get_value(common_remote_client_algs, Config)], + CommonAuths = + [{AuthMethod,Alg} || AuthMethod <- proplists:get_value(common_authmethods, Config), + Alg <- case AuthMethod of + publickey -> + PublicKeyAlgs; + _ -> + [' '] + end + ], + SysDir = setup_local_hostdir(hd(PublicKeyAlgs), Config), + chk_all_algos(?FUNCTION_NAME, CommonAuths, Config, + fun(AuthMethod,Alg) -> + {Opts,UsrDir} = + case AuthMethod of + publickey -> + {[{user_passwords, [{?USER,?BAD_PASSWD}]}], + setup_remote_priv_and_local_auth_keys(Alg, Config) + }; + _ -> + {[{user_passwords, [{?USER,?PASSWD}]}], + new_dir(Config) + } + end, + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods, atom_to_list(AuthMethod)}, + {system_dir, SysDir}, + {user_dir, UsrDir}, + {failfun, fun ssh_test_lib:failfun/2} + | Opts + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+3]).\r\n'", + [<<"Answer=4">>], + ""), + ssh:stop_daemon(Server), + R + end). %%-------------------------------------------------------------------- -all_algorithms_otp_is_client(Config) -> - CommonAlgs = proplists:get_value(common_server_algs, Config), +all_algorithms_sftp_exec_reneg_otp_is_client(Config) -> + CommonAlgs = proplists:get_value(common_remote_server_algs, Config), {IP,Port} = ip_port(Config), - chk_all_algos(CommonAlgs, Config, + chk_all_algos(?FUNCTION_NAME, CommonAlgs, Config, fun(Tag, Alg) -> - ssh:connect(IP, Port, [{user,?USER}, - {password,?PWD}, - {auth_methods, "password"}, - {user_dir, new_dir(Config)}, - {preferred_algorithms, [{Tag,[Alg]}]}, - {silently_accept_hosts,true}, - {user_interaction,false} + ConnRes = + ssh:connect(IP, Port, + [{user,?USER}, + {password,?PASSWD}, + {auth_methods, "password"}, + {user_dir, new_dir(Config)}, + {preferred_algorithms, [{Tag,[Alg]}]}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) , + test_erl_client_reneg(ConnRes, % Seems that max 10 channels may be open in sshd + [{exec,1}, + {sftp,5}, + {no_subsyst,1}, + {setenv, 1}, + {sftp_async,1} ]) end). %%-------------------------------------------------------------------- -all_algorithms_otp_is_server(Config) -> - CommonAlgs = proplists:get_value(common_client_algs, Config), +all_algorithms_sftp_exec_reneg_otp_is_server(Config) -> + CommonAlgs = proplists:get_value(common_remote_client_algs, Config), UserDir = setup_remote_priv_and_local_auth_keys('ssh-rsa', Config), - chk_all_algos(CommonAlgs, Config, + chk_all_algos(?FUNCTION_NAME, CommonAlgs, Config, fun(Tag,Alg) -> HostKeyAlg = case Tag of public_key -> Alg; _ -> 'ssh-rsa' end, + SftpRootDir = new_dir(Config), + %% ct:log("Rootdir = ~p",[SftpRootDir]), {Server, Host, HostPort} = ssh_test_lib:daemon(0, [{preferred_algorithms, [{Tag,[Alg]}]}, {system_dir, setup_local_hostdir(HostKeyAlg, Config)}, {user_dir, UserDir}, - {user_passwords, [{?USER,?PWD}]}, - {failfun, fun ssh_test_lib:failfun/2} + {user_passwords, [{?USER,?PASSWD}]}, + {failfun, fun ssh_test_lib:failfun/2}, + {subsystems, + [ssh_sftpd:subsystem_spec([{cwd,SftpRootDir}, + {root,SftpRootDir}]), + {"echo_10",{ssh_echo_server,[10,[{dbg,true}]]}} + ]} ]), - R = exec_from_docker(Config, Host, HostPort, - "hi_there.\r\n", - [<<"hi_there">>], - ""), + R = do([fun() -> + exec_from_docker(Config, Host, HostPort, + "hi_there.\r\n", + [<<"hi_there">>], + "") + end, + fun() -> + sftp_tests_erl_server(Config, Host, HostPort, SftpRootDir, UserDir) + end + ]), ssh:stop_daemon(Server), R end). %%-------------------------------------------------------------------- +send_recv_big_with_renegotiate_otp_is_client(Config) -> + %% Connect to the remote openssh server: + {IP,Port} = ip_port(Config), + {ok,C} = ssh:connect(IP, Port, [{user,?USER}, + {password,?PASSWD}, + {user_dir, setup_remote_auth_keys_and_local_priv('ssh-rsa', Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + + %% Open a channel and exec the Linux 'cat' command at the openssh side. + %% This 'cat' will read stdin and write to stdout until an eof is read from stdin. + {ok, Ch1} = ssh_connection:session_channel(C, infinity), + success = ssh_connection:exec(C, Ch1, "cat", infinity), + + %% Build big binary + HalfSizeBytes = 100*1000*1000, + Data = << <<X:32>> || X <- lists:seq(1, HalfSizeBytes div 4)>>, + + %% Send the data. Must spawn a process to avoid deadlock. The client will block + %% until all is sent through the send window. But the server will stop receiveing + %% when the servers send-window towards the client is full. + %% Since the client can't receive before the server has received all but 655k from the client + %% ssh_connection:send/4 is blocking... + spawn_link( + fun() -> + ct:comment("Sending ~p Mbytes with renegotiation in the middle",[2*byte_size(Data)/1000000]), + %% ct:log("sending first ~p bytes",[byte_size(Data)]), + ok = ssh_connection:send(C, Ch1, Data, 10000), + %% ct:log("Init renegotiation test",[]), + Kex1 = renegotiate_test(init, C), + %% ct:log("sending next ~p bytes",[byte_size(Data)]), + ok = ssh_connection:send(C, Ch1, Data, 10000), + %% ct:log("Finnish renegotiation test",[]), + renegotiate_test(Kex1, C), + %% ct:log("sending eof",[]), + ok = ssh_connection:send_eof(C, Ch1) + %%, ct:log("READY, sent ~p bytes",[2*byte_size(Data)]) + end), + + {eof,ReceivedData} = + loop_until(fun({eof,_}) -> true; + (_ ) -> false + end, + fun(Acc) -> + %%ct:log("Get more ~p",[ ExpectedSize-byte_size(Acc) ]), + receive + {ssh_cm, C, {eof,Ch}} when Ch==Ch1 -> + %% ct:log("eof received",[]), + {eof,Acc}; + + {ssh_cm, C, {data,Ch,0,B}} when Ch==Ch1, + is_binary(B) -> + %% ct:log("(1) Received ~p bytes (total ~p), missing ~p bytes", + %% [byte_size(B), + %% byte_size(B)+byte_size(Acc), + %% 2*byte_size(Data)-(byte_size(B)+byte_size(Acc))]), + ssh_connection:adjust_window(C, Ch1, byte_size(B)), + <<Acc/binary, B/binary>> + end + end, + <<>>), + + ExpectedData = <<Data/binary, Data/binary>>, + case ReceivedData of + ExpectedData -> + %% ct:log("Correct data returned",[]), + %% receive close messages + loop_until(fun(Left) -> %% ct:log("Expect: ~p",[Left]), + Left == [] + end, + fun([Next|Rest]) -> + receive + {ssh_cm,C,Next} -> Rest + end + end, + [%% Already received: {eof, Ch1}, + {exit_status,Ch1,0}, + {closed,Ch1}] + ), + ok; + _ when is_binary(ReceivedData) -> + ct:fail("~p bytes echoed but ~p expected", [byte_size(ReceivedData), 2*byte_size(Data)]) + end. + +%%-------------------------------------------------------------------- %% Utilities --------------------------------------------------------- %%-------------------------------------------------------------------- -exec_from_docker(WhatEver, {0,0,0,0}, HostPort, Command, Expects, ExtraSshArg) -> - exec_from_docker(WhatEver, host_ip(), HostPort, Command, Expects, ExtraSshArg); +%%-------------------------------------------------------------------- +%% +%% A practical meta function +%% +loop_until(CondFun, DoFun, Acc) -> + case CondFun(Acc) of + true -> + Acc; + false -> + loop_until(CondFun, DoFun, DoFun(Acc)) + end. + +%%-------------------------------------------------------------------- +%% +%% Exec the Command in the docker. Add the arguments ExtraSshArg in the +%% ssh command. +%% +%% If Expects is returned, then return 'ok', else return {fail,Msg}. +%% exec_from_docker(Config, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)), is_list(Config) -> {DockerIP,DockerPort} = ip_port(Config), {ok,C} = ssh:connect(DockerIP, DockerPort, [{user,?USER}, - {password,?PWD}, + {password,?PASSWD}, {user_dir, new_dir(Config)}, {silently_accept_hosts,true}, {user_interaction,false} ]), - R = exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg), + R = exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg, Config), ssh:close(C), - R; - -exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)) -> - SSH_from_docker = - lists:concat(["sshpass -p ",?PWD," ", - "/buildroot/ssh/bin/ssh -p ",HostPort," -o 'CheckHostIP=no' -o 'StrictHostKeyChecking=no' ", - ExtraSshArg," ", - inet_parse:ntoa(HostIP)," " - ]), - ExecCommand = SSH_from_docker ++ Command, - R = exec(C, ExecCommand), - case R of - {ok,{ExitStatus,Result}} when ExitStatus == 0 -> + R. + +exec_from_docker(C, DestIP, DestPort, Command, Expects, ExtraSshArg, Config) when is_binary(hd(Expects)) -> + ExecCommand = + lists:concat( + ["sshpass -p ",?PASSWD," " + | case proplists:get_value(ssh_version,Config) of + "dropbear" ++ _ -> + ["dbclient -y -y -p ",DestPort," ",ExtraSshArg," ",iptoa(DestIP)," "]; + + _ -> %% OpenSSH or compatible + ["/buildroot/ssh/bin/ssh -o 'CheckHostIP=no' -o 'StrictHostKeyChecking=no' ", + ExtraSshArg," -p ",DestPort," ",iptoa(DestIP)," "] + end]) ++ Command, + + case exec(C, ExecCommand) of + {ok,{ExitStatus,Result}} = R when ExitStatus == 0 -> case binary:match(Result, Expects) of nomatch -> ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), @@ -327,28 +469,26 @@ exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_bin _ -> ok end; - {ok,_} -> + {ok,_} = R -> ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), {fail, "Exit status =/= 0"}; - _ -> + R -> ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), {fail, "Couldn't login to host"} end. - - exec(C, Cmd) -> - ct:log("~s",[Cmd]), + %% ct:log("~s",[Cmd]), {ok,Ch} = ssh_connection:session_channel(C, 10000), success = ssh_connection:exec(C, Ch, Cmd, 10000), - exec_result(C, Ch). + result_of_exec(C, Ch). -exec_result(C, Ch) -> - exec_result(C, Ch, undefined, <<>>). +result_of_exec(C, Ch) -> + result_of_exec(C, Ch, undefined, <<>>). -exec_result(C, Ch, ExitStatus, Acc) -> +result_of_exec(C, Ch, ExitStatus, Acc) -> receive {ssh_cm,C,{closed,Ch}} -> %%ct:log("CHAN ~p got *closed*",[Ch]), @@ -356,29 +496,37 @@ exec_result(C, Ch, ExitStatus, Acc) -> {ssh_cm,C,{exit_status,Ch,ExStat}} when ExitStatus == undefined -> %%ct:log("CHAN ~p got *exit status ~p*",[Ch,ExStat]), - exec_result(C, Ch, ExStat, Acc); + result_of_exec(C, Ch, ExStat, Acc); {ssh_cm,C,{data,Ch,_,Data}=_X} when ExitStatus == undefined -> %%ct:log("CHAN ~p got ~p",[Ch,_X]), - exec_result(C, Ch, ExitStatus, <<Acc/binary, Data/binary>>); + result_of_exec(C, Ch, ExitStatus, <<Acc/binary, Data/binary>>); _Other -> %%ct:log("OTHER: ~p",[_Other]), - exec_result(C, Ch, ExitStatus, Acc) + result_of_exec(C, Ch, ExitStatus, Acc) after 5000 -> - %%ct:log("NO MORE, received so far:~n~s",[Acc]), + ct:log("NO MORE, received so far:~n~s",[Acc]), {error, timeout} end. -chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> +%%-------------------------------------------------------------------- +%% +%% Loop through all {Tag,Alg} pairs in CommonAlgs, call DoTestFun(Tag,Alg) which +%% returns one of {ok,C}, ok, or Other. +%% +%% The chk_all_algos returns 'ok' or {fail,FaledAlgosList} +%% + +chk_all_algos(FunctionName, CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> ct:comment("~p algorithms",[length(CommonAlgs)]), %% Check each algorithm Failed = lists:foldl( fun({Tag,Alg}, FailedAlgos) -> - ct:log("Try ~p",[Alg]), + %% ct:log("Try ~p",[Alg]), case DoTestFun(Tag,Alg) of {ok,C} -> ssh:close(C), @@ -387,10 +535,10 @@ chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> FailedAlgos; Other -> ct:log("FAILED! ~p ~p: ~p",[Tag,Alg,Other]), - [Alg|FailedAlgos] + [{Alg,Other}|FailedAlgos] end end, [], CommonAlgs), - ct:pal("~s", [format_result_table_use_all_algos(Config, CommonAlgs, Failed)]), + ct:pal("~s", [format_result_table_use_all_algos(FunctionName, Config, CommonAlgs, Failed)]), case Failed of [] -> ok; @@ -398,6 +546,41 @@ chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> {fail, Failed} end. + + +%%%---------------------------------------------------------------- +%%% +%%% Call all Funs as Fun() which returns 'ok', {ok,C} or Other. +%%% do/1 returns 'ok' or the first encountered value that is not +%%% successful. +%%% + +do(Funs) -> + do(Funs, 1). + +do([Fun|Funs], N) -> + case Fun() of + ok -> + %% ct:log("Fun ~p ok",[N]), + do(Funs, N-1); + {ok,C} -> + %% ct:log("Fun ~p {ok,C}",[N]), + ssh:close(C), + do(Funs, N-1); + Other -> + ct:log("Fun ~p FAILED:~n~p",[N, Other]), + Other + end; + +do([], _) -> + %% ct:log("All Funs ok",[]), + ok. + +%%-------------------------------------------------------------------- +%% +%% Functions to set up local and remote host's and user's keys and directories +%% + setup_local_hostdir(KeyAlg, Config) -> setup_local_hostdir(KeyAlg, new_dir(Config), Config). setup_local_hostdir(KeyAlg, HostDir, Config) -> @@ -428,7 +611,7 @@ setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config) -> ok = file:write_file(DstFile++".pub", Publ), %% Remote auth_methods with public key {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, - {password, ?PWD }, + {password, ?PASSWD }, {auth_methods, "password"}, {silently_accept_hosts,true}, {user_interaction,false} @@ -460,7 +643,7 @@ setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> ok = file:write_file(AuthKeyFile, Publ), %% Remote private and public key {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, - {password, ?PWD }, + {password, ?PASSWD }, {auth_methods, "password"}, {silently_accept_hosts,true}, {user_interaction,false} @@ -485,6 +668,7 @@ priv_pub_keys(KeySubDir, Type, Config, KeyAlg) -> {ok, {Priv,Publ}}. +%%%---------------- The default filenames src_filename(user, 'ssh-rsa' ) -> "id_rsa"; src_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; src_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; @@ -516,7 +700,11 @@ dst_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; dst_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key". -format_result_table_use_all_algos(Config, CommonAlgs, Failed) -> +%%-------------------------------------------------------------------- +%% +%% Format the result table for chk_all_algos/4 +%% +format_result_table_use_all_algos(FunctionName, Config, CommonAlgs, Failed) -> %% Write a nice table with the result AlgHead = 'Algorithm', AlgWidth = lists:max([length(atom_to_list(A)) || {_,A} <- CommonAlgs]), @@ -529,23 +717,25 @@ format_result_table_use_all_algos(Config, CommonAlgs, Failed) -> end, {io_lib:format('~s ~*s ~s~n', [Tag, -AlgWidth, A, - case lists:member(A,Failed) of - true -> "<<<< FAIL <<<<"; - false-> "(ok)" + case proplists:get_value(A,Failed) of + undefined -> "(ok)"; + Err -> io_lib:format("<<<< FAIL <<<< ~p",[Err]) end]), T} end, undefined, CommonAlgs), Vssh = proplists:get_value(ssh_version,Config,""), - Vssl = proplists:get_value(ssl_version,Config,""), - io_lib:format("~nResults, Peer versions: ~s and ~s~n" + io_lib:format("~nResults of ~p, Peer version: ~s~n~n" "Tag ~*s Result~n" "=====~*..=s=======~n~s" - ,[Vssh,Vssl, - -AlgWidth,AlgHead, + ,[FunctionName, Vssh, + -AlgWidth, AlgHead, AlgWidth, "", ResultTable]). - +%%-------------------------------------------------------------------- +%% +%% Docker handling: start_docker/1 and stop_docker/1 +%% start_docker(Ver) -> Cmnd = lists:concat(["docker run -itd --rm -p 1234 ",?DOCKER_PFX,":",Ver]), Id0 = os:cmd(Cmnd), @@ -572,6 +762,10 @@ is_docker_sha(L) -> (_) -> false end, L). +%%-------------------------------------------------------------------- +%% +%% Misc docker info functions + ip_port(Config) -> {_Ver,{IP,Port},_} = proplists:get_value(id,Config), {IP,Port}. @@ -590,6 +784,23 @@ ip(Id) -> {ok,IP} = inet:parse_address(IPstr), IP. +%%-------------------------------------------------------------------- +%% +%% Normalize the host returned from ssh_test_lib + +iptoa({0,0,0,0}) -> inet_parse:ntoa(host_ip()); +iptoa(IP) -> inet_parse:ntoa(IP). + +host_ip() -> + {ok,Name} = inet:gethostname(), + {ok,#hostent{h_addr_list = [IP|_]}} = inet_res:gethostbyname(Name), + IP. + +%%-------------------------------------------------------------------- +%% +%% Create a new fresh directory or clear an existing one +%% + new_dir(Config) -> PrivDir = proplists:get_value(priv_dir, Config), SubDirName = integer_to_list(erlang:system_time()), @@ -626,20 +837,34 @@ delete_all_contents(Dir) -> end end, Fs). +%%-------------------------------------------------------------------- +%% +%% Find the intersection of algoritms for otp ssh and the docker ssh. +%% Returns {ok, ServerHello, Server, ClientHello, Client} where Server are the algorithms common +%% with the docker server and analogous for Client. +%% +%% Client may be undefined if no usable client is found. +%% +%% Both Server and Client are lists of {Tag,AlgName}. +%% + common_algs(Config, IP, Port) -> case remote_server_algs(IP, Port) of - {ok, {RemoteHelloBin, RemoteServerKexInit}} -> + {ok, {ServerHello, RemoteServerKexInit}} -> + RemoteServerAlgs = kexint_msg2default_algorithms(RemoteServerKexInit), + Server = find_common_algs(RemoteServerAlgs, + use_algorithms(ServerHello)), + ct:log("Remote server:~n~p~n~p",[ServerHello, RemoteServerAlgs]), case remote_client_algs(Config) of - {ok,{_Hello,RemoteClientKexInit}} -> - RemoteServerAlgs = kexint_msg2default_algorithms(RemoteServerKexInit), - Server = find_common_algs(RemoteServerAlgs, - use_algorithms(RemoteHelloBin)), + {ok,{ClientHello,RemoteClientKexInit}} -> RemoteClientAlgs = kexint_msg2default_algorithms(RemoteClientKexInit), Client = find_common_algs(RemoteClientAlgs, - use_algorithms(RemoteHelloBin)), - ct:log("Docker server algorithms:~n ~p~n~nDocker client algorithms:~n ~p", - [RemoteServerAlgs,RemoteClientAlgs]), - {ok, Server, Client}; + use_algorithms(ClientHello)), + ct:log("Remote client:~n~p~n~p",[ClientHello, RemoteClientAlgs]), + {ok, ServerHello, Server, ClientHello, Client}; + {error,_} =TO -> + ct:log("Remote client algs can't be found: ~p",[TO]), + {ok, ServerHello, Server, undefined, undefined}; Other -> Other end; @@ -648,6 +873,24 @@ common_algs(Config, IP, Port) -> end. +chk_hellos(Hs, Str) -> + lists:foldl( + fun(H, Acc) -> + try binary:split(H, <<"-">>, [global]) + of + %% [<<"SSH">>,<<"2.0">>|_] -> + %% Acc; + [<<"SSH">>,OldVer = <<"1.",_/binary>>|_] -> + io_lib:format("~s, Old SSH ver ~s",[Acc,OldVer]); + _ -> + Acc + catch + _:_ -> + Acc + end + end, Str, Hs). + + find_common_algs(Remote, Local) -> [{T,V} || {T,Vs} <- ssh_test_lib:extract_algos( ssh_test_lib:intersection(Remote, @@ -685,12 +928,18 @@ kexint_msg2default_algorithms(#ssh_msg_kexinit{kex_algorithms = Kex, {server2client,ssh_test_lib:to_atoms(CompS2C)}]}]. - +%%-------------------------------------------------------------------- +%% +%% Find the algorithms supported by the remote server +%% +%% Connect with tcp to the server, send a hello and read the returned +%% server hello and kexinit message. +%% remote_server_algs(IP, Port) -> case try_gen_tcp_connect(IP, Port, 5) of {ok,S} -> ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), - receive_hello(S, <<>>); + receive_hello(S); {error,Error} -> {error,Error} end. @@ -709,6 +958,13 @@ try_gen_tcp_connect(_, _, _) -> {error, "No contact"}. +%%-------------------------------------------------------------------- +%% +%% Find the algorithms supported by the remote client +%% +%% Set up a fake ssh server and make the remote client connect to it. Use +%% hello message and the kexinit message. +%% remote_client_algs(Config) -> Parent = self(), Ref = make_ref(), @@ -719,7 +975,7 @@ remote_client_algs(Config) -> Parent ! {addr,Ref,IP,Port}, {ok,S} = gen_tcp:accept(Sl), ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), - Parent ! {Ref,receive_hello(S, <<>>)} + Parent ! {Ref,receive_hello(S)} end), receive {addr,Ref,IP,Port} -> @@ -732,14 +988,28 @@ remote_client_algs(Config) -> receive {Ref, Result} -> Result - after 15000 -> - {error, timeout2} + after 5000 -> + {error, {timeout,2}} end - after 15000 -> - {error, timeout1} + after 5000 -> + {error, {timeout,1}} end. +%%% Receive a few packets from the remote server or client and find what is supported: + +receive_hello(S) -> + try + receive_hello(S, <<>>) + of + Result -> + Result + catch + Class:Error -> + ST = erlang:get_stacktrace(), + {error, {Class,Error,ST}} + end. + receive_hello(S, Ack) -> %% The Ack is to collect bytes until the full message is received @@ -747,20 +1017,19 @@ receive_hello(S, Ack) -> {tcp, S, Bin0} when is_binary(Bin0) -> case binary:split(<<Ack/binary, Bin0/binary>>, [<<"\r\n">>,<<"\r">>,<<"\n">>]) of [Hello = <<"SSH-2.0-",_/binary>>, NextPacket] -> - ct:log("Got 2.0 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + %% ct:log("Got 2.0 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), {ok, {Hello, receive_kexinit(S, NextPacket)}}; [Hello = <<"SSH-1.99-",_/binary>>, NextPacket] -> - ct:comment("Old SSH ~s",["1.99"]), - ct:log("Got 1.99 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + %% ct:log("Got 1.99 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), {ok, {Hello, receive_kexinit(S, NextPacket)}}; [Bin] when size(Bin) < 256 -> - ct:log("Got part of hello (~p chars):~n~s~n~s",[size(Bin),Bin, - [io_lib:format('~2.16.0b ',[C]) - || C <- binary_to_list(Bin0) - ] - ]), + %% ct:log("Got part of hello (~p chars):~n~s~n~s",[size(Bin),Bin, + %% [io_lib:format('~2.16.0b ',[C]) + %% || C <- binary_to_list(Bin0) + %% ] + %% ]), receive_hello(S, Bin0); _ -> @@ -804,11 +1073,326 @@ receive_kexinit(S, Ack) -> throw(timeout) end. +%%%---------------------------------------------------------------- +%%% Test of sftp from the OpenSSH client side +%%% +sftp_tests_erl_server(Config, ServerIP, ServerPort, ServerRootDir, UserDir) -> + try + Cmnds = prepare_local_directory(ServerRootDir), + call_sftp_in_docker(Config, ServerIP, ServerPort, Cmnds, UserDir), + check_local_directory(ServerRootDir) + catch + Class:Error -> + ST = erlang:get_stacktrace(), + {error, {Class,Error,ST}} + end. -host_ip() -> - {ok,Name} = inet:gethostname(), - {ok,#hostent{h_addr_list = [IP|_]}} = inet_res:gethostbyname(Name), - IP. +prepare_local_directory(ServerRootDir) -> + file:write_file(filename:join(ServerRootDir,"tst1"), + <<"Some test text">> + ), + ["get tst1", + "put tst1 tst2", + "put tst1 tst3", + "rename tst1 ex_tst1", + "rm tst3", + "mkdir mydir", + "cd mydir", + "put tst1 file_1", + "put tst1 unreadable_file", + "chmod 222 unreadable_file", + "exit"]. + +check_local_directory(ServerRootDir) -> + case lists:sort(ok(file:list_dir(ServerRootDir)) -- [".",".."]) of + ["ex_tst1","mydir","tst2"] -> + {ok,Expect} = file:read_file(filename:join(ServerRootDir,"ex_tst1")), + case file:read_file(filename:join(ServerRootDir,"tst2")) of + {ok,Expect} -> + case lists:sort(ok(file:list_dir(filename:join(ServerRootDir,"mydir"))) -- [".",".."]) of + ["file_1","unreadable_file"] -> + case file:read_file(filename:join([ServerRootDir,"mydir","file_1"])) of + {ok,Expect} -> + case file:read_file(filename:join([ServerRootDir,"mydir","unreadable_file"])) of + {error,_} -> + ok; + {ok,_} -> + {error, {could_read_unreadable,"mydir/unreadable_file"}} + end; + {ok,Other} -> + ct:log("file_1:~n~s~nExpected:~n~s",[Other,Expect]), + {error, {bad_contents_in_file,"mydir/file_1"}} + end; + Other -> + ct:log("Directory ~s~n~p",[filename:join(ServerRootDir,"mydir"),Other]), + {error,{bad_dir_contents,"mydir"}} + end; + {ok,Other} -> + ct:log("tst2:~n~s~nExpected:~n~s",[Other,Expect]), + {error, {bad_contents_in_file,"tst2"}} + end; + ["tst1"] -> + {error,{missing_file,"tst2"}}; + Other -> + ct:log("Directory ~s~n~p",[ServerRootDir,Other]), + {error,{bad_dir_contents,"/"}} + end. + +call_sftp_in_docker(Config, ServerIP, ServerPort, Cmnds, UserDir) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{user,?USER}, + {password,?PASSWD}, + {user_dir, UserDir}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + + %% Make commands for "expect" in the docker: + PreExpectCmnds = ["spawn /buildroot/ssh/bin/sftp -oPort="++integer_to_list(ServerPort)++ + " -oCheckHostIP=no -oStrictHostKeyChecking=no " ++ + iptoa(ServerIP)++"\n" + ], + PostExpectCmnds= [], + ExpectCmnds = + PreExpectCmnds ++ + ["expect \"sftp>\" {send \""++Cmnd++"\n\"}\n" || Cmnd <- Cmnds] ++ + PostExpectCmnds, + + %% Make an commands file in the docker + {ok,Ch} = ssh_sftp:start_channel(C, [{timeout,10000}]), + ok = ssh_sftp:write_file(Ch, "commands", erlang:iolist_to_binary(ExpectCmnds)), + ok = ssh_sftp:stop_channel(Ch), + + %% Call expect in the docker + {ok, Ch1} = ssh_connection:session_channel(C, infinity), + Kex1 = renegotiate_test(init, C), + success = ssh_connection:exec(C, Ch1, "expect commands", infinity), + + renegotiate_test(Kex1, C), + recv_log_msgs(C, Ch1), + + %% Done. + ssh:close(C). + +recv_log_msgs(C, Ch) -> + receive + {ssh_cm,C,{closed,Ch}} -> + %% ct:log("Channel closed ~p",[{closed,1}]), + ok; + {ssh_cm,C,{data,Ch,1,Msg}} -> + ct:log("*** ERROR from docker:~n~s",[Msg]), + recv_log_msgs(C, Ch); + {ssh_cm,C,_Msg} -> + %% ct:log("Got ~p",[_Msg]), + recv_log_msgs(C, Ch) + end. +%%%---------------------------------------------------------------- +%%%---------------------------------------------------------------- +%%% +%%% Tests from the Erlang client side +%%% +%%%---------------------------------------------------------------- +%%%---------------------------------------------------------------- +test_erl_client_reneg({ok,C}, Spec) -> + %% Start the test processes on the connection C: + Parent = self(), + Pids = [spawn( + fun() -> + Parent ! {self(), TestType, Id, one_test_erl_client(TestType,Id,C)} + end + ) + || {TestType,N} <- Spec, + Id <- lists:seq(1,N)], + + Kex1 = renegotiate_test(init, C), + + %% Collect the results: + case lists:filter( + fun(R) -> R=/=ok end, + [receive + {Pid,_TestType,_Id,ok} -> + %% ct:log("Test ~p:~p passed!", [_TestType,_Id]), + ok; + {Pid,TestType,Id,OtherResult} -> + ct:log("~p:~p ~p ~p~n~p",[?MODULE,?LINE,TestType,Id,OtherResult]), + {error,TestType,Id} + end || Pid <- Pids]) + of + [] -> + renegotiate_test(Kex1, C), + {ok,C}; + Other -> + renegotiate_test(Kex1, C), + Other + end; + +test_erl_client_reneg(Error, _) -> + Error. + + +one_test_erl_client(exec, Id, C) -> + {ok, Ch} = ssh_connection:session_channel(C, infinity), + success = ssh_connection:exec(C, Ch, "echo Hi there", 5000), + case loop_until(fun({eof,_}) -> true; + (_ ) -> false + end, + fun(Acc) -> + receive + {ssh_cm, C, {eof,Ch}} -> + {eof,Acc}; + {ssh_cm, C, {data,Ch,0,B}} when is_binary(B) -> + <<Acc/binary, B/binary>> + end + end, + <<>>) of + {eof,<<"Hi there\n">>} -> + ok; + Other -> + ct:pal("exec Got other ~p", [Other]), + {error, {exec,Id,bad_msg,Other,undefined}} + end; + +one_test_erl_client(no_subsyst, Id, C) -> + {ok, Ch} = ssh_connection:session_channel(C, infinity), + case ssh_connection:subsystem(C, Ch, "foo", infinity) of + failure -> + ok; + Other -> + ct:pal("no_subsyst Got other ~p", [Other]), + {error, {no_subsyst,Id,bad_ret,Other,undefined}} + end; + +one_test_erl_client(setenv, Id, C) -> + {ok, Ch} = ssh_connection:session_channel(C, infinity), + Var = "ENV_TEST", + Value = lists:concat(["env_test_",Id,"_",erlang:system_time()]), + Env = case ssh_connection:setenv(C, Ch, Var, Value, infinity) of + success -> binary_to_list(Value++"\n"); + failure -> <<"\n">> + end, + success = ssh_connection:exec(C, Ch, "echo $"++Var, 5000), + case loop_until(fun({eof,_}) -> true; + (_ ) -> false + end, + fun(Acc) -> + receive + {ssh_cm, C, {eof,Ch}} -> + {eof,Acc}; + {ssh_cm, C, {data,Ch,0,B}} when is_binary(B) -> + <<Acc/binary, B/binary>> + end + end, + <<>>) of + {eof,Env} -> + ok; + Other -> + ct:pal("setenv Got other ~p", [Other]), + {error, {setenv,Id,bad_msg,Other,undefined}} + end; + +one_test_erl_client(SFTP, Id, C) when SFTP==sftp ; SFTP==sftp_async -> + try + {ok,Ch} = ssh_sftp:start_channel(C, [{timeout,10000}]), + %% A new fresh name of a new file tree: + RootDir = lists:concat(["r_",Id,"_",erlang:system_time()]), + %% Check that it does not exist: + false = lists:member(RootDir, ok(ssh_sftp:list_dir(Ch, "."))), + %% Create it: + ok = ssh_sftp:make_dir(Ch, RootDir), + {ok, #file_info{type=directory, access=read_write}} = ssh_sftp:read_file_info(Ch, RootDir), + R = do_sftp_tests_erl_client(SFTP, C, Ch, Id, RootDir), + catch ssh_sftp:stop_channel(Ch), + R + catch + Class:Error -> + ST = erlang:get_stacktrace(), + {error, {SFTP,Id,Class,Error,ST}} + end. + + + +do_sftp_tests_erl_client(sftp_async, _C, Ch, _Id, RootDir) -> + FileName1 = "boring_name", + F1 = filename:join(RootDir, FileName1), + %% Open a new handle and start writing: + {ok,Handle1} = ssh_sftp:open(Ch, F1, [write,binary]), + {async,Aref1} = ssh_sftp:awrite(Ch, Handle1, <<0:250000/unsigned-unit:8>>), + wait_for_async_result(Aref1); + +do_sftp_tests_erl_client(sftp, _C, Ch, _Id, RootDir) -> + FileName0 = "f0", + F0 = filename:join(RootDir, FileName0), + + %% Create and write a file: + ok = ssh_sftp:write_file(Ch, + F0 = filename:join(RootDir, FileName0), + Data0 = mkbin(1234,240)), + {ok,Data0} = ssh_sftp:read_file(Ch, F0), + {ok, #file_info{type=regular, access=read_write, size=1234}} = ssh_sftp:read_file_info(Ch, F0), + + %% Re-write: + {ok,Handle0} = ssh_sftp:open(Ch, F0, [write,read,binary]), + ok = ssh_sftp:pwrite(Ch, Handle0, 16, Data0_1=mkbin(10,255)), + + <<B1:16/binary, _:10/binary, B2:(1234-26)/binary>> = Data0, + FileContents = <<B1:16/binary, Data0_1:10/binary, B2:(1234-26)/binary>>, + + <<_:1/binary, Part:25/binary, _/binary>> = FileContents, + {ok, Part} = ssh_sftp:pread(Ch, Handle0, 1, 25), + + %% Check: + {ok, FileContents} = ssh_sftp:pread(Ch, Handle0, 0, 1234), + ok = ssh_sftp:close(Ch, Handle0), + + %% Check in another way: + {ok, FileContents} = ssh_sftp:read_file(Ch, F0), + + %% Remove write access rights and check that it can't be written: + ok = ssh_sftp:write_file_info(Ch, F0, #file_info{mode=8#400}), %read}), + {ok, #file_info{type=regular, access=read}} = ssh_sftp:read_file_info(Ch, F0), + {error,permission_denied} = ssh_sftp:write_file(Ch, F0, mkbin(10,14)), + + %% Test deletion of file and dir: + [FileName0] = ok(ssh_sftp:list_dir(Ch, RootDir)) -- [".", ".."], + ok = ssh_sftp:delete(Ch, F0), + [] = ok(ssh_sftp:list_dir(Ch, RootDir)) -- [".", ".."], + ok = ssh_sftp:del_dir(Ch, RootDir), + false = lists:member(RootDir, ok(ssh_sftp:list_dir(Ch, "."))), + ok. + + +wait_for_async_result(Aref) -> + receive + {async_reply, Aref, Result} -> + Result + after + 60000 -> + timeout + end. + + +mkbin(Size, Byte) -> + list_to_binary(lists:duplicate(Size,Byte)). + +ok({ok,X}) -> X. + +%%%---------------------------------------------------------------- +renegotiate_test(init, ConnectionRef) -> + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + ssh_connection_handler:renegotiate(ConnectionRef), + %%ct:log("Renegotiate test initiated!",[]), + Kex1; + +renegotiate_test(Kex1, ConnectionRef) -> + case ssh_test_lib:get_kex_init(ConnectionRef) of + Kex1 -> + ct:log("Renegotiate test failed, Kex1 == Kex2!",[]), + error(renegotiate_failed); + _ -> + %% ct:log("Renegotiate test passed!",[]), + ok + end. diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh new file mode 100755 index 0000000000..85973081d0 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh @@ -0,0 +1,28 @@ +#!/bin/sh + +# ./create-dropbear-ssh + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ubuntubuildbase + + WORKDIR /buildroot + + RUN apt-get -y update + RUN apt-get -y upgrade + RUN apt-get -y install openssh-sftp-server +%% RUN echo 81 | apt-get -y install dropbear + +EOF + +# Build the image: +docker build -t ssh_compat_suite-ssh-dropbear -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh-run b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh-run new file mode 100755 index 0000000000..d98c0cfaa3 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh-run @@ -0,0 +1,27 @@ +#!/bin/sh + +# ./create-dropbear-ssh-run + +VER=v2016.72 + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ssh_compat_suite-ssh-dropbear-installed:${VER} + + WORKDIR /buildroot + + CMD dropbear -F -p 1234 + +EOF + +# Build the image: +docker build -t ssh_compat_suite-ssh:dropbear${VER} -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image index 983c57b18b..2e08408841 100755 --- a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image @@ -47,7 +47,8 @@ cat - > TempDockerFile <<EOF RUN ./configure --without-pie \ --prefix=/buildroot/ssh \ --with-ssl-dir=/buildroot/ssl \ - --with-pam + --with-pam \ + LDFLAGS=-Wl,-R/buildroot/ssl/lib RUN make RUN make install RUN echo UsePAM yes >> /buildroot/ssh/etc/sshd_config diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image index 66f8358b8a..4ab2a8bddc 100755 --- a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image @@ -23,6 +23,16 @@ case "$1" in ;; esac +case $1$2 in + openssl0.9.8[a-l]) + CONFIG_FLAGS=no-asm + ;; + *) + CONFIG_FLAGS= + ;; +esac + + # This way of fetching the tar-file separate from the docker commands makes # http-proxy handling way easier. The wget command handles the $https_proxy # variable while the docker command must have /etc/docker/something changed @@ -42,10 +52,10 @@ cat - > TempDockerFile <<EOF WORKDIR ${FAM}-${VER} - RUN ./config --prefix=/buildroot/ssl + RUN ./config --prefix=/buildroot/ssl ${CONFIG_FLAGS} RUN make - RUN make install + RUN make install_sw RUN echo Built ${FAM}-${VER} EOF diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all index 16b9c21d9f..0dcf8cb570 100755 --- a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all @@ -3,19 +3,21 @@ UBUNTU_VERSION=16.04 SSH_SSL_VERSIONS=(\ - openssh 4.4p1 openssl 0.9.8zh \ - openssh 4.5p1 openssl 0.9.8zh \ - openssh 5.0p1 openssl 0.9.8zh \ - openssh 6.2p2 openssl 0.9.8zh \ - openssh 6.3p1 openssl 0.9.8zh \ - \ - openssh 7.1p1 openssl 1.0.0t \ - \ - openssh 7.1p1 openssl 1.0.1p \ - \ - openssh 6.6p1 openssl 1.0.2n \ - openssh 7.1p1 openssl 1.0.2n \ - openssh 7.6p1 openssl 1.0.2n \ + openssh 4.4p1 openssl 0.9.8c \ + openssh 4.5p1 openssl 0.9.8m \ + openssh 5.0p1 openssl 0.9.8za \ + openssh 6.2p2 openssl 0.9.8c \ + openssh 6.3p1 openssl 0.9.8zh \ + \ + openssh 7.1p1 openssl 1.0.0a \ + \ + openssh 7.1p1 openssl 1.0.1p \ + \ + openssh 6.6p1 openssl 1.0.2n \ + openssh 7.1p1 openssl 1.0.2n \ + openssh 7.6p1 openssl 1.0.2n \ + \ + openssh 7.6p1 libressl 2.6.4 \ ) if [ "x$1" == "x-b" ] diff --git a/lib/ssh/test/ssh_engine_SUITE.erl b/lib/ssh/test/ssh_engine_SUITE.erl index daf93891e9..c131a70973 100644 --- a/lib/ssh/test/ssh_engine_SUITE.erl +++ b/lib/ssh/test/ssh_engine_SUITE.erl @@ -55,16 +55,22 @@ basic_tests() -> init_per_suite(Config) -> ssh:start(), ?CHECK_CRYPTO( - case load_engine() of - {ok,E} -> - [{engine,E}|Config]; - {error, notsup} -> - {skip, "Engine not supported on this OpenSSL version"}; - {error, bad_engine_id} -> - {skip, "Dynamic Engine not supported"}; - Other -> - ct:log("Engine load failed: ~p",[Other]), - {fail, "Engine load failed"} + case crypto:info_lib() of + [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] -> + {skip, "Strange Engine stuff"}; + + _ -> + case load_engine() of + {ok,E} -> + [{engine,E}|Config]; + {error, notsup} -> + {skip, "Engine not supported on this OpenSSL version"}; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"}; + Other -> + ct:log("Engine load failed: ~p",[Other]), + {fail, "Engine load failed"} + end end ). diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 144ec7f8fd..bb09ca4c8b 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -70,7 +70,8 @@ hostkey_fingerprint_check_sha256/1, hostkey_fingerprint_check_sha384/1, hostkey_fingerprint_check_sha512/1, - hostkey_fingerprint_check_list/1 + hostkey_fingerprint_check_list/1, + save_accepted_host_option/1 ]). %%% Common test callbacks @@ -124,6 +125,7 @@ all() -> id_string_own_string_server, id_string_own_string_server_trail_space, id_string_random_server, + save_accepted_host_option, {group, hardening_tests} ]. @@ -211,7 +213,8 @@ init_per_testcase(_TestCase, Config) -> end_per_testcase(TestCase, Config) when TestCase == server_password_option; TestCase == server_userpassword_option; TestCase == server_pwdfun_option; - TestCase == server_pwdfun_4_option -> + TestCase == server_pwdfun_4_option ; + TestCase == save_accepted_host_option -> UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), ssh_test_lib:del_dirs(UserDir), end_per_testcase(Config); @@ -219,7 +222,9 @@ end_per_testcase(_TestCase, Config) -> end_per_testcase(Config). end_per_testcase(_Config) -> + ct:log("~p: Before ssh:stop()",[?FUNCTION_NAME]), ssh:stop(), + ct:log("~p: After ssh:stop()",[?FUNCTION_NAME]), ok. %%-------------------------------------------------------------------- @@ -1314,6 +1319,36 @@ try_to_connect(Connect, Host, Port, Pid, Tref, N) -> end. %%-------------------------------------------------------------------- +save_accepted_host_option(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + KnownHosts = filename:join(UserDir, "known_hosts"), + file:make_dir(UserDir), + file:delete(KnownHosts), + SysDir = proplists:get_value(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {user_passwords, [{"vego", "morot"}]} + ]), + {error,enoent} = file:read_file(KnownHosts), + + {ok,_C1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "vego"}, + {password, "morot"}, + {user_interaction, false}, + {save_accepted_host, false}, + {user_dir, UserDir}]), + {error,enoent} = file:read_file(KnownHosts), + + {ok,_C2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "vego"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + {ok,_} = file:read_file(KnownHosts), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index 3920a1c592..d453a2e143 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -42,7 +42,9 @@ suite() -> all() -> [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile, - killed_acceptor_restarts]. + killed_acceptor_restarts, + shell_channel_tree + ]. groups() -> []. @@ -246,6 +248,98 @@ killed_acceptor_restarts(Config) -> {error,closed} = ssh:connection_info(C2,[client_version]). %%------------------------------------------------------------------------- +shell_channel_tree(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = proplists:get_value(data_dir, Config), + TimeoutShell = + fun() -> + io:format("TimeoutShell started!~n",[]), + timer:sleep(5000), + ct:pal("~p TIMEOUT!",[self()]) + end, + {Daemon, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {shell, fun(_User) -> + spawn(TimeoutShell) + end + } + ]), + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + [ChannelSup|_] = Sups0 = chk_empty_con_daemon(Daemon), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:shell(ConnectionRef,ChannelId0), + + ?wait_match([{_, GroupPid,worker,[ssh_channel]}], + supervisor:which_children(ChannelSup), + [GroupPid]), + {links,GroupLinks} = erlang:process_info(GroupPid, links), + [ShellPid] = GroupLinks--[ChannelSup], + ct:pal("GroupPid = ~p, ShellPid = ~p",[GroupPid,ShellPid]), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"TimeoutShell started!\r\n">>}} -> + receive + %%---- wait for the subsystem to terminate + {ssh_cm,ConnectionRef,{closed,ChannelId0}} -> + ct:pal("Subsystem terminated",[]), + case {chk_empty_con_daemon(Daemon), + process_info(GroupPid), + process_info(ShellPid)} of + {Sups0, undefined, undefined} -> + %% SUCCESS + ssh:stop_daemon(Daemon); + {Sups0, _, undefined} -> + ssh:stop_daemon(Daemon), + ct:fail("Group proc lives!"); + {Sups0, undefined, _} -> + ssh:stop_daemon(Daemon), + ct:fail("Shell proc lives!"); + _ -> + ssh:stop_daemon(Daemon), + ct:fail("Sup tree changed!") + end + after 10000 -> + ssh:close(ConnectionRef), + ssh:stop_daemon(Daemon), + ct:fail("CLI Timeout") + end + after 10000 -> + ssh:close(ConnectionRef), + ssh:stop_daemon(Daemon), + ct:fail("CLI Timeout") + end. + + +chk_empty_con_daemon(Daemon) -> + ?wait_match([{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], + supervisor:which_children(Daemon), + [SubSysSup,AccSup]), + ?wait_match([{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}], + supervisor:which_children(SubSysSup), + [ConnectionSup,ChannelSup]), + ?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}], + supervisor:which_children(AccSup)), + ?wait_match([{_, _, worker,[ssh_connection_handler]}], + supervisor:which_children(ConnectionSup)), + ?wait_match([], supervisor:which_children(ChannelSup)), + [ChannelSup, ConnectionSup, SubSysSup, AccSup]. + +%%------------------------------------------------------------------------- %% Help functions %%------------------------------------------------------------------------- check_sshd_system_tree(Daemon, Config) -> diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 2d7bf75847..f97c3b1352 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -53,7 +53,7 @@ daemon(Host, Options) -> daemon(Host, Port, Options) -> - ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), + %% ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), case ssh:daemon(Host, Port, Options) of {ok, Pid} -> {ok,L} = ssh:daemon_info(Pid), @@ -199,15 +199,17 @@ init_io_server(TestCase) -> loop_io_server(TestCase, Buff0) -> receive - {input, TestCase, Line} -> + {input, TestCase, Line} = _INP -> + %%ct:log("io_server ~p:~p ~p got ~p",[?MODULE,?LINE,self(),_INP]), loop_io_server(TestCase, Buff0 ++ [Line]); - {io_request, From, ReplyAs, Request} -> + {io_request, From, ReplyAs, Request} = _REQ-> + %%ct:log("io_server ~p:~p ~p got ~p",[?MODULE,?LINE,self(),_REQ]), {ok, Reply, Buff} = io_request(Request, TestCase, From, ReplyAs, Buff0), io_reply(From, ReplyAs, Reply), loop_io_server(TestCase, Buff); {'EXIT',_, _} = _Exit -> -%% ct:log("ssh_test_lib:loop_io_server/2 got ~p",[_Exit]), + ct:log("ssh_test_lib:loop_io_server/2 got ~p",[_Exit]), ok after 30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE]) diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index b20764ce47..9df404d7ed 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -48,19 +48,9 @@ all() -> end. groups() -> - [{erlang_client, [], [erlang_shell_client_openssh_server, - erlang_client_openssh_server_exec_compressed, - erlang_client_openssh_server_setenv, - erlang_client_openssh_server_publickey_dsa, - erlang_client_openssh_server_publickey_rsa, - erlang_client_openssh_server_password, - erlang_client_openssh_server_kexs, - erlang_client_openssh_server_nonexistent_subsystem, - erlang_client_openssh_server_renegotiate + [{erlang_client, [], [erlang_shell_client_openssh_server ]}, - {erlang_server, [], [erlang_server_openssh_client_public_key_dsa, - erlang_server_openssh_client_public_key_rsa, - erlang_server_openssh_client_renegotiate + {erlang_server, [], [erlang_server_openssh_client_renegotiate ]} ]. @@ -100,15 +90,6 @@ end_per_group(_, Config) -> Config. -init_per_testcase(erlang_server_openssh_client_public_key_dsa, Config) -> - chk_key(sshc, 'ssh-dss', ".ssh/id_dsa", Config); -init_per_testcase(erlang_server_openssh_client_public_key_rsa, Config) -> - chk_key(sshc, 'ssh-rsa', ".ssh/id_rsa", Config); -init_per_testcase(erlang_client_openssh_server_publickey_dsa, Config) -> - chk_key(sshd, 'ssh-dss', ".ssh/id_dsa", Config); -init_per_testcase(erlang_client_openssh_server_publickey_rsa, Config) -> - chk_key(sshd, 'ssh-rsa', ".ssh/id_rsa", Config); - init_per_testcase(erlang_server_openssh_client_renegotiate, Config) -> case os:type() of {unix,_} -> ssh:start(), Config; @@ -122,27 +103,6 @@ end_per_testcase(_TestCase, _Config) -> ssh:stop(), ok. - -chk_key(Pgm, Name, File, Config) -> - case ssh_test_lib:openssh_supports(Pgm, public_key, Name) of - false -> - {skip,lists:concat(["openssh client does not support ",Name])}; - true -> - {ok,[[Home]]} = init:get_argument(home), - KeyFile = filename:join(Home, File), - case file:read_file(KeyFile) of - {ok, Pem} -> - case public_key:pem_decode(Pem) of - [{_,_, not_encrypted}] -> - init_per_testcase('__default__',Config); - _ -> - {skip, {error, "Has pass phrase can not be used by automated test case"}} - end; - _ -> - {skip, lists:concat(["no ~/",File])} - end - end. - %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -160,219 +120,6 @@ erlang_shell_client_openssh_server(Config) when is_list(Config) -> receive_logout(), receive_normal_exit(Shell). -%-------------------------------------------------------------------- -erlang_client_openssh_server_exec() -> - [{doc, "Test api function ssh_connection:exec"}]. - -erlang_client_openssh_server_exec(Config) when is_list(Config) -> - ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user_interaction, false}]), - {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId0, - "echo testing", infinity), - Data0 = {ssh_cm, ConnectionRef, {data, ChannelId0, 0, <<"testing\n">>}}, - case ssh_test_lib:receive_exec_result(Data0) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0); - {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} - = ExitStatus0} -> - ct:log("0: Collected data ~p", [ExitStatus0]), - ssh_test_lib:receive_exec_result(Data0, - ConnectionRef, ChannelId0); - Other0 -> - ct:fail(Other0) - end, - - {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId1, - "echo testing1", infinity), - Data1 = {ssh_cm, ConnectionRef, {data, ChannelId1, 0, <<"testing1\n">>}}, - case ssh_test_lib:receive_exec_result(Data1) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1); - {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId1, 0}} - = ExitStatus1} -> - ct:log("0: Collected data ~p", [ExitStatus1]), - ssh_test_lib:receive_exec_result(Data1, - ConnectionRef, ChannelId1); - Other1 -> - ct:fail(Other1) - end. - -%%-------------------------------------------------------------------- -erlang_client_openssh_server_exec_compressed() -> - [{doc, "Test that compression option works"}]. - -erlang_client_openssh_server_exec_compressed(Config) when is_list(Config) -> - CompressAlgs = [zlib, '[email protected]',none], - case ssh_test_lib:ssh_supports(CompressAlgs, compression) of - {false,L} -> - {skip, io_lib:format("~p compression is not supported",[L])}; - - true -> - ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user_interaction, false}, - {preferred_algorithms, - [{compression,CompressAlgs}]}]), - {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId, - "echo testing", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"testing\n">>}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId); - {unexpected_msg,{ssh_cm, ConnectionRef, - {exit_status, ChannelId, 0}} = ExitStatus} -> - ct:log("0: Collected data ~p", [ExitStatus]), - ssh_test_lib:receive_exec_result(Data, ConnectionRef, ChannelId); - Other -> - ct:fail(Other) - end - end. - -%%-------------------------------------------------------------------- -erlang_client_openssh_server_kexs() -> - [{doc, "Test that we can connect with different KEXs."}]. - -erlang_client_openssh_server_kexs(Config) when is_list(Config) -> - KexAlgos = try proplists:get_value(kex, proplists:get_value(common_algs,Config)) - catch _:_ -> [] - end, - comment(KexAlgos), - case KexAlgos of - [] -> {skip, "No common kex algorithms"}; - _ -> - Success = - lists:foldl( - fun(Kex, Acc) -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user_interaction, false}, - {preferred_algorithms, - [{kex,[Kex]}]}]), - - {ok, ChannelId} = - ssh_connection:session_channel(ConnectionRef, infinity), - success = - ssh_connection:exec(ConnectionRef, ChannelId, - "echo testing", infinity), - - ExpectedData = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"testing\n">>}}, - case ssh_test_lib:receive_exec_result(ExpectedData) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - Acc; - {unexpected_msg,{ssh_cm, ConnectionRef, - {exit_status, ChannelId, 0}} = ExitStatus} -> - ct:log("0: Collected data ~p", [ExitStatus]), - ssh_test_lib:receive_exec_result(ExpectedData, ConnectionRef, ChannelId), - Acc; - Other -> - ct:log("~p failed: ~p",[Kex,Other]), - false - end - end, true, KexAlgos), - case Success of - true -> - ok; - false -> - {fail, "Kex failed for one or more algos"} - end - end. - -%%-------------------------------------------------------------------- -erlang_client_openssh_server_setenv() -> - [{doc, "Test api function ssh_connection:setenv"}]. - -erlang_client_openssh_server_setenv(Config) when is_list(Config) -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user_interaction, false}]), - {ok, ChannelId} = - ssh_connection:session_channel(ConnectionRef, infinity), - Env = case ssh_connection:setenv(ConnectionRef, ChannelId, - "ENV_TEST", "testing_setenv", - infinity) of - success -> - <<"tesing_setenv\n">>; - failure -> - <<"\n">> - end, - success = ssh_connection:exec(ConnectionRef, ChannelId, - "echo $ENV_TEST", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, Env}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId); - {unexpected_msg,{ssh_cm, ConnectionRef, - {data,0,1, UnxpectedData}}} -> - %% Some os may return things as - %% ENV_TEST: Undefined variable.\n" - ct:log("UnxpectedData: ~p", [UnxpectedData]), - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId); - {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId, 0}} - = ExitStatus} -> - ct:log("0: Collected data ~p", [ExitStatus]), - ssh_test_lib:receive_exec_result(Data, - ConnectionRef, ChannelId); - Other -> - ct:fail(Other) - end. - -%%-------------------------------------------------------------------- - -%% setenv not meaningfull on erlang ssh daemon! - -%%-------------------------------------------------------------------- -erlang_client_openssh_server_publickey_rsa(Config) -> - erlang_client_openssh_server_publickey_X(Config, 'ssh-rsa'). - -erlang_client_openssh_server_publickey_dsa(Config) -> - erlang_client_openssh_server_publickey_X(Config, 'ssh-dss'). - - -erlang_client_openssh_server_publickey_X(_Config, Alg) -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{pref_public_key_algs, [Alg]}, - {user_interaction, false}, - {auth_methods, "publickey"}, - silently_accept_hosts]), - {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, Channel), - ok = ssh:close(ConnectionRef). - -%%-------------------------------------------------------------------- -erlang_server_openssh_client_public_key_dsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. -erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, 'ssh-dss'). - -erlang_server_openssh_client_public_key_rsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. -erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, 'ssh-rsa'). - - -erlang_server_openssh_client_public_key_X(Config, Alg) -> - SystemDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - KnownHosts = filename:join(PrivDir, "known_hosts"), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {preferred_algorithms,[{public_key, [Alg]}]}, - {auth_methods, "publickey"}, - {failfun, fun ssh_test_lib:failfun/2}]), - ct:sleep(500), - - Cmd = ssh_test_lib:open_sshc_cmd(Host, Port, - [" -o UserKnownHostsFile=", KnownHosts, - " -o StrictHostKeyChecking=no"], - "1+1."), - OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), - ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT), - ssh:stop_daemon(Pid). - %%-------------------------------------------------------------------- %% Test that the Erlang/OTP server can renegotiate with openSSH erlang_server_openssh_client_renegotiate(Config) -> @@ -430,108 +177,6 @@ erlang_server_openssh_client_renegotiate(Config) -> end. %%-------------------------------------------------------------------- -erlang_client_openssh_server_renegotiate(_Config) -> - process_flag(trap_exit, true), - IO = ssh_test_lib:start_io_server(), - Ref = make_ref(), - Parent = self(), - - Shell = - spawn_link( - fun() -> - Host = ssh_test_lib:hostname(), - Options = [{user_interaction, false}, - {silently_accept_hosts,true}], - group_leader(IO, self()), - {ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options), - ct:log("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]), - case ssh_connection:session_channel(ConnRef, infinity) of - {ok,ChannelId} -> - success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []), - Args = [{channel_cb, ssh_shell}, - {init_args,[ConnRef, ChannelId]}, - {cm, ConnRef}, {channel_id, ChannelId}], - {ok, State} = ssh_channel:init([Args]), - Parent ! {ok, Ref, ConnRef}, - ssh_channel:enter_loop(State); - Error -> - Parent ! {error, Ref, Error} - end, - receive - nothing -> ok - end - end), - - receive - {error, Ref, Error} -> - ct:fail("Error=~p",[Error]); - {ok, Ref, ConnectionRef} -> - IO ! {input, self(), "echo Hej1\n"}, - receive_data("Hej1", ConnectionRef), - Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), - ssh_connection_handler:renegotiate(ConnectionRef), - IO ! {input, self(), "echo Hej2\n"}, - receive_data("Hej2", ConnectionRef), - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), - IO ! {input, self(), "exit\n"}, - receive_logout(), - receive_normal_exit(Shell), - true = (Kex1 =/= Kex2) - end. - -%%-------------------------------------------------------------------- -erlang_client_openssh_server_password() -> - [{doc, "Test client password option"}]. -erlang_client_openssh_server_password(Config) when is_list(Config) -> - %% to make sure we don't public-key-auth - UserDir = proplists:get_value(data_dir, Config), - {error, Reason0} = - ssh:connect(any, ?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_interaction, false}, - {user_dir, UserDir}]), - - ct:log("Test of user foo that does not exist. " - "Error msg: ~p~n", [Reason0]), - - User = string:strip(os:cmd("whoami"), right, $\n), - - case length(string:tokens(User, " ")) of - 1 -> - {error, Reason1} = - ssh:connect(any, ?SSH_DEFAULT_PORT, - [{silently_accept_hosts, true}, - {user, User}, - {password, "foo"}, - {user_interaction, false}, - {user_dir, UserDir}]), - ct:log("Test of wrong Pasword. " - "Error msg: ~p~n", [Reason1]); - _ -> - ct:log("Whoami failed reason: ~n", []) - end. - -%%-------------------------------------------------------------------- - -erlang_client_openssh_server_nonexistent_subsystem() -> - [{doc, "Test client password option"}]. -erlang_client_openssh_server_nonexistent_subsystem(Config) when is_list(Config) -> - - ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{user_interaction, false}, - silently_accept_hosts]), - - {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - - failure = ssh_connection:subsystem(ConnectionRef, ChannelId, "foo", infinity). - -%%-------------------------------------------------------------------- -% -%% Not possible to send password with openssh without user interaction -%% -%%-------------------------------------------------------------------- -%%-------------------------------------------------------------------- %%% Internal functions ----------------------------------------------- %%-------------------------------------------------------------------- receive_data(Data, Conn) -> diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 004db6e3a2..6aaa22a6b4 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.6.4 +SSH_VSN = 4.6.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 8fcda78ed5..3db5aa19ac 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -138,17 +138,20 @@ <tag><c>sslsocket() =</c></tag> <item><p>opaque()</p></item> - <tag><marker id="type-protocol"/><c>protocol() =</c></tag> + <tag><marker id="type-protocol"/><c>protocol_version() =</c></tag> <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> <tag><c>ciphers() =</c></tag> - <item><p><c>= [ciphersuite()] | string()</c></p> - <p>According to old API.</p></item> + <item><p><c>= [ciphersuite()]</c></p> + <p>Tuples and string formats accepted by versions + before ssl-8.2.4 will be converted for backwards compatibility</p></item> <tag><c>ciphersuite() =</c></tag> - - <item><p><c>{key_exchange(), cipher(), MAC::hash()} | - {key_exchange(), cipher(), MAC::hash(), PRF::hash()}</c></p></item> + <item><p><c> + #{key_exchange := key_exchange(), + cipher := cipher(), + mac := MAC::hash() | aead, + prf := PRF::hash() | default_prf} </c></p></item> <tag><c>key_exchange()=</c></tag> <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk @@ -165,6 +168,12 @@ <tag><c>prf_random() =</c></tag> <item><p><c>client_random | server_random</c></p></item> + <tag><c>cipher_filters() =</c></tag> + <item><p><c> [{key_exchange | cipher | mac | prf, algo_filter()}])</c></p></item> + + <tag><c>algo_filter() =</c></tag> + <item><p>fun(key_exchange() | cipher() | hash() | aead | default_prf) -> true | false </p></item> + <tag><c>srp_param_type() =</c></tag> <item><p><c>srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | srp_8192</c></p></item> @@ -456,7 +465,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> with the selected CA as trusted anchor and the rest of the chain.</p></item> - <tag><c>{versions, [protocol()]}</c></tag> + <tag><c>{versions, [protocol_version()]}</c></tag> <item><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option <c>protocol_version</c>. If the environment option is not set, it defaults @@ -829,14 +838,34 @@ fun(srp, Username :: string(), UserState :: term()) -> </section> <funcs> + + <func> + <name>append_cipher_suites(Deferred, Suites) -> ciphers() </name> + <fsummary></fsummary> + <type> + <v>Deferred = ciphers() | cipher_filters() </v> + <v>Suites = ciphers() </v> + </type> + <desc><p>Make <c>Deferred</c> suites become the least preferred + suites, that is put them at the end of the cipher suite list + <c>Suites</c> after removing them from <c>Suites</c> if + present. <c>Deferred</c> may be a list of cipher suits or a + list of filters in which case the filters are use on <c>Suites</c> to + extract the Deferred cipher list.</p> + </desc> + </func> + <func> <name>cipher_suites() -></name> - <name>cipher_suites(Type) -> ciphers()</name> + <name>cipher_suites(Type) -> old_ciphers()</name> <fsummary>Returns a list of supported cipher suites.</fsummary> <type> <v>Type = erlang | openssl | all</v> </type> - <desc><p>Returns a list of supported cipher suites. + <desc> + <p>Returns a list of supported cipher suites. + This function will become deprecated in OTP 21, and replaced + by <seealso marker="#cipher_suites-2">ssl:cipher-suites/2</seealso> <c>cipher_suites()</c> is equivalent to <c>cipher_suites(erlang).</c> Type <c>openssl</c> is provided for backwards compatibility with the old SSL, which used OpenSSL. <c>cipher_suites(all)</c> returns @@ -844,12 +873,25 @@ fun(srp, Username :: string(), UserState :: term()) -> in <c>cipher_suites(erlang)</c> but included in <c>cipher_suites(all)</c> are not used unless explicitly configured by the user.</p> + </desc> + </func> + + <func> + <name>cipher_suites(Supported, Version) -> ciphers()</name> + <fsummary>Returns a list of all default or + all supported cipher suites.</fsummary> + <type> + <v> Supported = default | all | anonymous </v> + <v> Version = protocol_version() </v> + </type> + <desc><p>Returns all default or all supported (except anonymous), or all anonymous cipher suites for a + TLS version</p> </desc> </func> <func> <name>eccs() -></name> - <name>eccs(protocol()) -> [named_curve()]</name> + <name>eccs(protocol_version()) -> [named_curve()]</name> <fsummary>Returns a list of supported ECCs.</fsummary> <desc><p>Returns a list of supported ECCs. <c>eccs()</c> @@ -1008,6 +1050,21 @@ fun(srp, Username :: string(), UserState :: term()) -> </desc> </func> + <func> + <name>filter_cipher_suites(Suites, Filters) -> ciphers()</name> + <fsummary></fsummary> + <type> + <v> Suites = ciphers()</v> + <v> Filters = cipher_filters()</v> + </type> + <desc><p>Removes cipher suites if any of the filter functions + returns false for any part of the cipher suite. This function + also calls default filter functions to make sure the cipher + suites are supported by crypto. If no filter function is supplied for some + part the default behaviour is fun(Algorithm) -> true.</p> + </desc> + </func> + <func> <name>format_error(Reason) -> string()</name> <fsummary>Returns an error string.</fsummary> @@ -1105,6 +1162,22 @@ fun(srp, Username :: string(), UserState :: term()) -> <p>Returns the address and port number of the peer.</p> </desc> </func> + + <func> + <name>prepend_cipher_suites(Preferred, Suites) -> ciphers()</name> + <fsummary></fsummary> + <type> + <v>Preferred = ciphers() | cipher_filters() </v> + <v>Suites = ciphers() </v> + </type> + <desc><p>Make <c>Preferred</c> suites become the most preferred + suites that is put them at the head of the cipher suite list + <c>Suites</c> after removing them from <c>Suites</c> if + present. <c>Preferred</c> may be a list of cipher suits or a + list of filters in which case the filters are use on <c>Suites</c> to + extract the preferred cipher list. </p> + </desc> + </func> <func> <name>prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> @@ -1332,7 +1405,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Returns version information relevant for the SSL application.</fsummary> <type> - <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol()] </v> + <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol_version()] </v> </type> <desc> <p>Returns version information relevant for the SSL diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index 61918a346d..775066ef7d 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -153,7 +153,51 @@ ok</code> </section> </section> - <section> + <section> + <title>Customizing cipher suits</title> + + <p>Fetch default cipher suite list for an TLS/DTLS version. Change default + to all to get all possible cipher suites.</p> + <code type="erl">1> Default = ssl:cipher_suites(default, 'tlsv1.2'). + [#{cipher => aes_256_gcm,key_exchange => ecdhe_ecdsa, + mac => aead,prf => sha384}, ....] +</code> + + <p>In OTP 20 it is desirable to remove all cipher suites + that uses rsa kexchange (removed from default in 21) </p> + <code type="erl">2> NoRSA = + ssl:filter_cipher_suites(Default, + [{key_exchange, fun(rsa) -> false; + (_) -> true end}]). + [...] + </code> + + <p> Pick just a few suites </p> + <code type="erl"> 3> Suites = + ssl:filter_cipher_suites(Default, + [{key_exchange, fun(ecdh_ecdsa) -> true; + (_) -> false end}, + {cipher, fun(aes_128_cbc) ->true; + (_) ->false end}]). + [#{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa, + mac => sha256,prf => sha256}, + #{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa,mac => sha, + prf => default_prf}] + </code> + + <p> Make some particular suites the most preferred, or least + preferred by changing prepend to append.</p> + <code type="erl"> 4>ssl:prepend_cipher_suites(Suites, Default). + [#{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa, + mac => sha256,prf => sha256}, + #{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa,mac => sha, + prf => default_prf}, + #{cipher => aes_256_cbc,key_exchange => ecdhe_ecdsa, + mac => sha384,prf => sha384}, ...] + </code> + </section> + + <section> <title>Using an Engine Stored Key</title> <p>Erlang ssl application is able to use private keys provided diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 9cb6934dce..03725089dd 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -758,10 +758,12 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} }. -next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ +next_dtls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{ dtls_record_buffer = Buf0, dtls_cipher_texts = CT0} = Buffers} = State0) -> - case dtls_record:get_dtls_records(Data, Buf0) of + case dtls_record:get_dtls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = @@ -771,6 +773,11 @@ next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ Alert end. +acceptable_record_versions(hello, _) -> + [dtls_record:protocol_version(Vsn) || Vsn <- ?ALL_DATAGRAM_SUPPORTED_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. + dtls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -828,7 +835,7 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, %% raw data from socket, unpack records handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_dtls_record(Data, State0) of + case next_dtls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2dcc6efc91..316de05532 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -30,7 +30,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_dtls_records/2, init_connection_states/2, empty_connection_state/1]). +-export([get_dtls_records/3, init_connection_states/2, empty_connection_state/1]). -export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2, init_connection_state_seq/2, current_connection_state_epoch/2]). @@ -163,17 +163,25 @@ current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, Epoch. %%-------------------------------------------------------------------- --spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_dtls_records(binary(), [dtls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records %% and returns it as a list of tls_compressed binaries also returns leftover %% data %%-------------------------------------------------------------------- -get_dtls_records(Data, <<>>) -> - get_dtls_records_aux(Data, []); -get_dtls_records(Data, Buffer) -> - get_dtls_records_aux(list_to_binary([Buffer, Data]), []). - +get_dtls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_dtls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_dtls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding DTLS records @@ -397,6 +405,8 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> client_verify_data => undefined, server_verify_data => undefined }. +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -431,15 +441,11 @@ get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); -get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), +get_dtls_records_aux(<<?BYTE(_), ?BYTE(_MajVer), ?BYTE(_MinVer), ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); -get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_dtls_records_aux(Data, Acc) -> case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of true -> diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index 51ee8ec047..0f6344b6f7 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -21,7 +21,7 @@ -include("ssl_cipher.hrl"). --export([suites/1, all_suites/1, hmac_hash/3, ecc_curves/1, +-export([suites/1, all_suites/1, anonymous_suites/1,hmac_hash/3, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1, cookie_secret/0, cookie_timeout/0]). @@ -40,6 +40,12 @@ all_suites(Version) -> end, ssl_cipher:all_suites(corresponding_tls_version(Version))). +anonymous_suites(Version) -> + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + ssl_cipher:anonymous_suites(corresponding_tls_version(Version))). + hmac_hash(MacAlg, MacSecret, Value) -> tls_v1:hmac_hash(MacAlg, MacSecret, Value). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 656ed94ea5..fb4448e180 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -39,7 +39,9 @@ ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1, versions/0, +-export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2, + prepend_cipher_suites/2, append_cipher_suites/2, + eccs/0, eccs/1, versions/0, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc @@ -379,19 +381,93 @@ negotiated_protocol(#sslsocket{pid = Pid}) -> cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:old_erl_cipher_suite() | string()]. +-spec cipher_suites(erlang | openssl | all) -> + [ssl_cipher:old_erl_cipher_suite() | string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default)]; cipher_suites(openssl) -> - [ssl_cipher:openssl_suite_name(Suite) || Suite <- available_suites(default)]; + [ssl_cipher:openssl_suite_name(Suite) || + Suite <- available_suites(default)]; cipher_suites(all) -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- +-spec cipher_suites(default | all | anonymous, tls_record:tls_version() | dtls_record:dtls_version() | + tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Returns all default and all supported cipher suites for a +%% TLS/DTLS version +%%-------------------------------------------------------------------- +cipher_suites(Base, Version) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + cipher_suites(Base, tls_record:protocol_version(Version)); +cipher_suites(Base, Version) when Version == 'dtlsv1.2'; + Version == 'dtlsv1'-> + cipher_suites(Base, dtls_record:protocol_version(Version)); +cipher_suites(Base, Version) -> + [ssl_cipher:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. + +%%-------------------------------------------------------------------- +-spec filter_cipher_suites([ssl_cipher:erl_cipher_suite()], + [{key_exchange | cipher | mac | prf, fun()}] | []) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Removes cipher suites if any of the filter functions returns false +%% for any part of the cipher suite. This function also calls default filter functions +%% to make sure the cipher suite are supported by crypto. +%%-------------------------------------------------------------------- +filter_cipher_suites(Suites, Filters0) -> + #{key_exchange_filters := KexF, + cipher_filters := CipherF, + mac_filters := MacF, + prf_filters := PrfF} + = ssl_cipher:crypto_support_filters(), + Filters = #{key_exchange_filters => add_filter(proplists:get_value(key_exchange, Filters0), KexF), + cipher_filters => add_filter(proplists:get_value(cipher, Filters0), CipherF), + mac_filters => add_filter(proplists:get_value(mac, Filters0), MacF), + prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, + ssl_cipher:filter_suites(Suites, Filters). +%%-------------------------------------------------------------------- +-spec prepend_cipher_suites([ssl_cipher:erl_cipher_suite()] | + [{key_exchange | cipher | mac | prf, fun()}], + [ssl_cipher:erl_cipher_suite()]) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Make <Preferred> suites become the most prefered +%% suites that is put them at the head of the cipher suite list +%% and remove them from <Suites> if present. <Preferred> may be a +%% list of cipher suits or a list of filters in which case the +%% filters are use on Suites to extract the the preferred +%% cipher list. +%% -------------------------------------------------------------------- +prepend_cipher_suites([First | _] = Preferred, Suites0) when is_map(First) -> + Suites = Preferred ++ (Suites0 -- Preferred), + Suites; +prepend_cipher_suites(Filters, Suites) -> + Preferred = filter_cipher_suites(Suites, Filters), + Preferred ++ (Suites -- Preferred). +%%-------------------------------------------------------------------- +-spec append_cipher_suites(Deferred :: [ssl_cipher:erl_cipher_suite()] | + [{key_exchange | cipher | mac | prf, fun()}], + [ssl_cipher:erl_cipher_suite()]) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Make <Deferred> suites suites become the +%% least prefered suites that is put them at the end of the cipher suite list +%% and removed them from <Suites> if present. +%% +%%-------------------------------------------------------------------- +append_cipher_suites([First | _] = Deferred, Suites0) when is_map(First)-> + Suites = (Suites0 -- Deferred) ++ Deferred, + Suites; +append_cipher_suites(Filters, Suites) -> + Deferred = filter_cipher_suites(Suites, Filters), + (Suites -- Deferred) ++ Deferred. + +%%-------------------------------------------------------------------- -spec eccs() -> tls_v1:curves(). %% Description: returns all supported curves across all versions %%-------------------------------------------------------------------- @@ -636,11 +712,17 @@ tls_version({254, _} = Version) -> available_suites(default) -> Version = tls_record:highest_protocol_version([]), ssl_cipher:filter_suites(ssl_cipher:suites(Version)); - available_suites(all) -> Version = tls_record:highest_protocol_version([]), ssl_cipher:filter_suites(ssl_cipher:all_suites(Version)). +supported_suites(default, Version) -> + ssl_cipher:suites(Version); +supported_suites(all, Version) -> + ssl_cipher:all_suites(Version); +supported_suites(anonymous, Version) -> + ssl_cipher:anonymous_suites(Version). + do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> tls_socket:listen(Transport, Port, Config); @@ -1150,17 +1232,21 @@ handle_cipher_option(Value, Version) when is_list(Value) -> binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); + default_binary_suites(Version); +binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) -> + Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], + binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - All = ssl_cipher:all_suites(tls_version(Version)), + All = ssl_cipher:all_suites(Version) ++ + ssl_cipher:anonymous_suites(Version), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); + default_binary_suites(Version); Ciphers -> Ciphers end; @@ -1173,6 +1259,9 @@ binary_cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). +default_binary_suites(Version) -> + ssl_cipher:filter_suites(ssl_cipher:suites(Version)). + tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, cipher => Cipher, @@ -1181,9 +1270,19 @@ tuple_to_map({Kex, Cipher, Mac}) -> tuple_to_map({Kex, Cipher, Mac, Prf}) -> #{key_exchange => Kex, cipher => Cipher, - mac => Mac, + mac => tuple_to_map_mac(Cipher, Mac), prf => Prf}. +%% Backwards compatible +tuple_to_map_mac(aes_128_gcm, _) -> + aead; +tuple_to_map_mac(aes_256_gcm, _) -> + aead; +tuple_to_map_mac(chacha20_poly1305, _) -> + aead; +tuple_to_map_mac(_, MAC) -> + MAC. + handle_eccs_option(Value, Version) when is_list(Value) -> {_Major, Minor} = tls_version(Version), try tls_v1:ecc_curves(Minor, Value) of @@ -1462,3 +1561,8 @@ reject_alpn_next_prot_options([Opt| AlpnNextOpts], Opts) -> false -> reject_alpn_next_prot_options(AlpnNextOpts, Opts) end. + +add_filter(undefined, Filters) -> + Filters; +add_filter(Filter, Filters) -> + [Filter | Filters]. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 2c46de29e2..c6927bd276 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -36,9 +36,10 @@ -export([security_parameters/2, security_parameters/3, suite_definition/1, erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, - suite/1, suites/1, all_suites/1, - ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + suite/1, suites/1, all_suites/1, crypto_support_filters/0, + ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, srp_suites/0, + srp_suites_anon/0, rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, + filter/2, filter_suites/1, filter_suites/2, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1]). @@ -53,7 +54,7 @@ -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type erl_cipher_suite() :: #{key_exchange := key_algo(), cipher := cipher(), - mac := hash(), + mac := hash() | aead, prf := hash() | default_prf %% Old cipher suites, version dependent }. -type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 @@ -320,7 +321,6 @@ suites({_, Minor}) -> all_suites({3, _} = Version) -> suites(Version) - ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) @@ -336,12 +336,12 @@ all_suites(Version) -> %%-------------------------------------------------------------------- anonymous_suites({3, N}) -> - anonymous_suites(N); + srp_suites_anon() ++ anonymous_suites(N); anonymous_suites({254, _} = Version) -> - anonymous_suites(dtls_v1:corresponding_tls_version(Version)) - -- [?TLS_DH_anon_WITH_RC4_128_MD5]; + dtls_v1:anonymous_suites(Version); anonymous_suites(N) when N >= 3 -> + psk_suites_anon(N) ++ [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, ?TLS_DH_anon_WITH_AES_256_GCM_SHA384, ?TLS_DH_anon_WITH_AES_128_CBC_SHA256, @@ -350,20 +350,20 @@ anonymous_suites(N) ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA, ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, ?TLS_DH_anon_WITH_RC4_128_MD5]; - -anonymous_suites(2) -> +anonymous_suites(2 = N) -> + psk_suites_anon(N) ++ [?TLS_ECDH_anon_WITH_AES_128_CBC_SHA, ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA, ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, ?TLS_DH_anon_WITH_DES_CBC_SHA, ?TLS_DH_anon_WITH_RC4_128_MD5]; - anonymous_suites(N) when N == 0; N == 1 -> - [?TLS_DH_anon_WITH_RC4_128_MD5, - ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, - ?TLS_DH_anon_WITH_DES_CBC_SHA - ]. + psk_suites_anon(N) ++ + [?TLS_DH_anon_WITH_RC4_128_MD5, + ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, + ?TLS_DH_anon_WITH_DES_CBC_SHA + ]. %%-------------------------------------------------------------------- -spec psk_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. @@ -373,38 +373,49 @@ anonymous_suites(N) when N == 0; %%-------------------------------------------------------------------- psk_suites({3, N}) -> psk_suites(N); - psk_suites(N) when N >= 3 -> [ - ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256 + ] ++ psk_suites(0); +psk_suites(_) -> + [?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, + ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, + ?TLS_RSA_PSK_WITH_RC4_128_SHA]. + +%%-------------------------------------------------------------------- +-spec psk_suites_anon(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the anonymous PSK cipher suites, only supported +%% if explicitly set by user. +%%-------------------------------------------------------------------- +psk_suites_anon({3, N}) -> + psk_suites_anon(N); +psk_suites_anon(N) + when N >= 3 -> + [ + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_PSK_WITH_AES_256_GCM_SHA384, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_PSK_WITH_AES_256_CBC_SHA384, ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, ?TLS_PSK_WITH_AES_128_GCM_SHA256, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 - ] ++ psk_suites(0); - -psk_suites(_) -> + ] ++ psk_suites_anon(0); +psk_suites_anon(_) -> [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, ?TLS_PSK_WITH_AES_256_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, ?TLS_PSK_WITH_AES_128_CBC_SHA, ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_PSK_WITH_RC4_128_SHA, - ?TLS_RSA_PSK_WITH_RC4_128_SHA, ?TLS_PSK_WITH_RC4_128_SHA]. - %%-------------------------------------------------------------------- -spec srp_suites() -> [cipher_suite()]. %% @@ -412,15 +423,24 @@ psk_suites(_) -> %% if explicitly set by user. %%-------------------------------------------------------------------- srp_suites() -> - [?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, + [?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA, ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA, - ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. + +%%-------------------------------------------------------------------- +-spec srp_suites_anon() -> [cipher_suite()]. +%% +%% Description: Returns a list of the SRP anonymous cipher suites, only supported +%% if explicitly set by user. +%%-------------------------------------------------------------------- +srp_suites_anon() -> + [?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA, + ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA, + ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA]. + %%-------------------------------------------------------------------- -spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -684,32 +704,32 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => psk, @@ -988,42 +1008,42 @@ suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_dss, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_dss, @@ -1033,74 +1053,74 @@ suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_dss, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_anon, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; %% RFC 5289 ECC AES-GCM Cipher Suites suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => dhe_rsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}. %%-------------------------------------------------------------------- @@ -1288,32 +1308,32 @@ suite(#{key_exchange := rsa_psk, %%% TLS 1.2 PSK Cipher Suites RFC 5487 suite(#{key_exchange := psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := rsa_psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := rsa_psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := psk, @@ -1545,119 +1565,119 @@ suite(#{key_exchange := ecdh_rsa, %% RFC 5288 AES-GCM Cipher Suites suite(#{key_exchange := rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_dss, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_dss, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_dss, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_dss, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_anon, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_anon, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites suite(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdh_ecdsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdh_ecdsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdhe_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdhe_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdh_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdh_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites suite(#{key_exchange := ecdhe_rsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; suite(#{key_exchange := ecdhe_ecdsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; suite(#{key_exchange := dhe_rsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. @@ -1817,9 +1837,9 @@ openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384. %%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite(). +-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite(). %% -%% Description: Return openssl cipher suite name. +%% Description: Return openssl cipher suite name if possible %%------------------------------------------------------------------- openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> "DHE-RSA-AES256-SHA"; @@ -2029,38 +2049,74 @@ filter(DerCert, Ciphers) -> {_, ecdsa} -> Ciphers1 -- rsa_signed_suites() end. - %%-------------------------------------------------------------------- --spec filter_suites([cipher_suite()]) -> [cipher_suite()]. +-spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) -> + [erl_cipher_suite()] | [cipher_suite()]. +%% +%% Description: Filter suites using supplied filter funs +%%------------------------------------------------------------------- +filter_suites(Suites, Filters) -> + ApplyFilters = fun(Suite) -> + filter_suite(Suite, Filters) + end, + lists:filter(ApplyFilters, Suites). + +filter_suite(#{key_exchange := KeyExchange, + cipher := Cipher, + mac := Hash, + prf := Prf}, + #{key_exchange_filters := KeyFilters, + cipher_filters := CipherFilters, + mac_filters := HashFilters, + prf_filters := PrfFilters}) -> + all_filters(KeyExchange, KeyFilters) andalso + all_filters(Cipher, CipherFilters) andalso + all_filters(Hash, HashFilters) andalso + all_filters(Prf, PrfFilters); +filter_suite(Suite, Filters) -> + filter_suite(suite_definition(Suite), Filters). + +%%-------------------------------------------------------------------- +-spec filter_suites([erl_cipher_suite()] | [cipher_suite()]) -> + [erl_cipher_suite()] | [cipher_suite()]. %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- -filter_suites(Suites = [Value|_]) when is_map(Value) -> - Algos = crypto:supports(), - Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun(#{key_exchange := KeyExchange, - cipher := Cipher, - mac := Hash, - prf := Prf}) -> - is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, Hashs) andalso - is_acceptable_prf(Prf, Hashs) - end, Suites); - filter_suites(Suites) -> + Filters = crypto_support_filters(), + filter_suites(Suites, Filters). + +all_filters(_, []) -> + true; +all_filters(Value, [Filter| Rest]) -> + case Filter(Value) of + true -> + all_filters(Value, Rest); + false -> + false + end. +crypto_support_filters() -> Algos = crypto:supports(), Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun(Suite) -> - #{key_exchange := KeyExchange, - cipher := Cipher, - mac := Hash, - prf := Prf} = suite_definition(Suite), - is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, Hashs) andalso - is_acceptable_prf(Prf, Hashs) - end, Suites). + #{key_exchange_filters => + [fun(KeyExchange) -> + is_acceptable_keyexchange(KeyExchange, + proplists:get_value(public_keys, Algos)) + end], + cipher_filters => + [fun(Cipher) -> + is_acceptable_cipher(Cipher, + proplists:get_value(ciphers, Algos)) + end], + mac_filters => + [fun(Hash) -> + is_acceptable_hash(Hash, Hashs) + end], + prf_filters => + [fun(Prf) -> + is_acceptable_prf(Prf, + proplists:get_value(hashs, Algos)) + end]}. is_acceptable_keyexchange(KeyExchange, _Algos) when KeyExchange == psk; KeyExchange == null -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 98776dcd59..63fae78195 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -999,8 +999,8 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, StateName, State); handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, _) -> - Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, {StateName, Msg}, State). + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, Msg}), + handle_own_alert(Alert, Version, StateName, State). handle_call({application_data, _Data}, _, _, _, _) -> %% In renegotiation priorities handshake, send data when handshake is finished diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 39f3ed996e..914ee9f22f 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -629,18 +629,34 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us flight_buffer = [] }. -next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, - tls_cipher_texts = CT0} = Buffers} = State0) -> - case tls_record:get_tls_records(Data, Buf0) of +next_tls_record(Data, StateName, #state{protocol_buffers = + #protocol_buffers{tls_record_buffer = Buf0, + tls_cipher_texts = CT0} = Buffers} + = State0) -> + case tls_record:get_tls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = Buffers#protocol_buffers{tls_record_buffer = Buf1, tls_cipher_texts = CT1}}); #alert{} = Alert -> - Alert + handle_record_alert(Alert, State0) end. +acceptable_record_versions(hello, #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS ++ ['sslv2']]; +acceptable_record_versions(hello, _) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. +handle_record_alert(#alert{description = ?BAD_RECORD_MAC}, + #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); +handle_record_alert(Alert, _) -> + Alert. + tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -649,7 +665,7 @@ tls_handshake_events(Packets) -> %% raw data from socket, upack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_tls_record(Data, State0) of + case next_tls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index ab179c1bf0..188ec6809d 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -32,7 +32,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_tls_records/2, init_connection_states/2]). +-export([get_tls_records/3, init_connection_states/2]). %% Encoding TLS records -export([encode_handshake/3, encode_alert_record/3, @@ -75,16 +75,25 @@ init_connection_states(Role, BeastMitigation) -> pending_write => Pending}. %%-------------------------------------------------------------------- --spec get_tls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_tls_records(binary(), [tls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% and returns it as a list of tls_compressed binaries also returns leftover %% Description: Given old buffer and new data from TCP, packs up a records %% data %%-------------------------------------------------------------------- -get_tls_records(Data, <<>>) -> - get_tls_records_aux(Data, []); -get_tls_records(Data, Buffer) -> - get_tls_records_aux(list_to_binary([Buffer, Data]), []). +get_tls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_tls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_tls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding @@ -385,6 +394,19 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. +assert_version(<<1:1, Length0:15, Data0:Length0/binary, _/binary>>, Versions) -> + case Data0 of + <<?BYTE(?CLIENT_HELLO), ?BYTE(Major), ?BYTE(Minor), _/binary>> -> + %% First check v2_hello_compatible mode is active + lists:member({2,0}, Versions) andalso + %% andalso we want to negotiate higher version + lists:member({Major, Minor}, Versions -- [{2,0}]); + _ -> + false + end; +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). + get_tls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length), Data:Length/binary, Rest/binary>>, Acc) -> @@ -428,10 +450,9 @@ get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, end; get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), - ?UINT16(Length), _/binary>>, + ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 179d1562cd..ce62017a7e 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -163,7 +163,8 @@ api_tests() -> server_name_indication_option, accept_pool, prf, - socket_options + socket_options, + cipher_suites ]. api_tests_tls() -> @@ -207,7 +208,7 @@ tls_cipher_tests() -> rc4_ecdsa_cipher_suites]. cipher_tests() -> - [cipher_suites, + [old_cipher_suites, cipher_suites_mix, ciphers_rsa_signed_certs, ciphers_rsa_signed_certs_openssl_names, @@ -702,8 +703,6 @@ secret_connection_info(Config) when is_list(Config) -> ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), - - Version = ssl_test_lib:protocol_version(Config), ssl_test_lib:check_result(Server, true, Client, true), @@ -1128,11 +1127,16 @@ fallback(Config) when is_list(Config) -> %%-------------------------------------------------------------------- cipher_format() -> - [{doc, "Test that cipher conversion from tuples to binarys works"}]. + [{doc, "Test that cipher conversion from maps | tuples | stings to binarys works"}]. cipher_format(Config) when is_list(Config) -> - {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), - ssl:close(Socket). - + {ok, Socket0} = ssl:listen(0, [{ciphers, ssl:cipher_suites(default, 'tlsv1.2')}]), + ssl:close(Socket0), + %% Legacy + {ok, Socket1} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket1), + {ok, Socket2} = ssl:listen(0, [{ciphers, ssl:cipher_suites(openssl)}]), + ssl:close(Socket2). + %%-------------------------------------------------------------------- peername() -> @@ -1283,10 +1287,62 @@ sockname_result(S) -> ssl:sockname(S). %%-------------------------------------------------------------------- + cipher_suites() -> - [{doc,"Test API function cipher_suites/0"}]. + [{doc,"Test API function cipher_suites/2, filter_cipher_suites/2" + " and prepend|append_cipher_suites/2"}]. cipher_suites(Config) when is_list(Config) -> + Version = ssl_test_lib:protocol_version(Config), + All = [_|_] = ssl:cipher_suites(all, Version), + Default = [_|_] = ssl:cipher_suites(default, Version), + Anonymous = [_|_] = ssl:cipher_suites(anonymous, Version), + true = length(Default) < length(All), + Filters = [{key_exchange, + fun(dhe_rsa) -> + true; + (_) -> + false + end + }, + {cipher, + fun(aes_256_cbc) -> + true; + (_) -> + false + end + }, + {mac, + fun(sha) -> + true; + (_) -> + false + end + } + ], + Cipher = #{cipher => aes_256_cbc, + key_exchange => dhe_rsa, + mac => sha, + prf => default_prf}, + [Cipher] = ssl:filter_cipher_suites(All, Filters), + [Cipher | Rest0] = ssl:prepend_cipher_suites([Cipher], Default), + [Cipher | Rest0] = ssl:prepend_cipher_suites(Filters, Default), + true = lists:member(Cipher, Default), + false = lists:member(Cipher, Rest0), + [Cipher | Rest1] = lists:reverse(ssl:append_cipher_suites([Cipher], Default)), + [Cipher | Rest1] = lists:reverse(ssl:append_cipher_suites(Filters, Default)), + true = lists:member(Cipher, Default), + false = lists:member(Cipher, Rest1), + [] = lists:dropwhile(fun(X) -> not lists:member(X, Default) end, Anonymous), + [] = lists:dropwhile(fun(X) -> not lists:member(X, All) end, Anonymous). + + +%%-------------------------------------------------------------------- + +old_cipher_suites() -> + [{doc,"Test API function cipher_suites/0"}]. + +old_cipher_suites(Config) when is_list(Config) -> MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, [_|_] = Suites = ssl:cipher_suites(), true = lists:member(MandatoryCipherSuite, Suites), @@ -3768,9 +3824,23 @@ rizzo() -> vunrable to Rizzo/Dungon attack"}]. rizzo(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}, + {cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), + run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_rizzo, []}). %%-------------------------------------------------------------------- @@ -3782,8 +3852,13 @@ no_rizzo_rc4(Config) when is_list(Config) -> Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), %% Test uses RSA certs - Ciphers = ssl_test_lib:rc4_suites(NVersion) -- [{ecdhe_ecdsa,rc4_128,sha}, - {ecdh_ecdsa,rc4_128,sha}], + Ciphers = ssl:filter_cipher_suites(ssl_test_lib:rc4_suites(NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3794,10 +3869,21 @@ rizzo_one_n_minus_one(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), - AllSuites = ssl_test_lib:available_suites(NVersion), - Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}, + {cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, - {?MODULE, send_recv_result_active_rizzo, []}). + {?MODULE, send_recv_result_active_rizzo, []}). rizzo_zero_n() -> [{doc,"Test that the 0/n-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. @@ -3806,8 +3892,13 @@ rizzo_zero_n(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), - AllSuites = ssl_test_lib:available_suites(NVersion), - Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, NVersion), + [{cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3815,9 +3906,16 @@ rizzo_disabled() -> [{doc,"Test that the mitigation of Rizzo/Dungon attack can be explicitly disabled"}]. rizzo_disabled(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, NVersion), + [{cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -4592,19 +4690,21 @@ rizzo_test(Cipher, Config, Version, Mfa) -> [{Cipher, Error}] end. -client_server_opts({KeyAlgo,_,_}, Config) +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == rsa orelse KeyAlgo == dhe_rsa orelse - KeyAlgo == ecdhe_rsa -> + KeyAlgo == ecdhe_rsa orelse + KeyAlgo == rsa_psk orelse + KeyAlgo == srp_rsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> {ssl_test_lib:ssl_options(client_dsa_opts, Config), ssl_test_lib:ssl_options(server_dsa_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_ecdsa orelse KeyAlgo == ecdhe_ecdsa -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_ecdsa orelse KeyAlgo == ecdhe_ecdsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdsa_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_rsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index f9cc6ab8b7..f9cc976815 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1024,55 +1024,46 @@ string_regex_filter(Str, Search) when is_list(Str) -> string_regex_filter(_Str, _Search) -> false. -anonymous_suites({3,_ } = Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]; -anonymous_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version)), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. - -psk_suites({3,_ } = Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]; -psk_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version)), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. - -psk_anon_suites({3,_ } = Version) -> - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]; -psk_anon_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(Suite))]. +anonymous_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)],[]). +psk_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []). + +psk_anon_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], + [{key_exchange, + fun(psk) -> + true; + (psk_dhe) -> + true; + (_) -> + false + end}]). + srp_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <- [{srp_anon,'3des_ede_cbc', sha}, - {srp_rsa, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_rsa, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}, - {srp_rsa, aes_256_cbc, sha}]])]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + [{key_exchange, + fun(srp_rsa) -> + true; + (_) -> + false + end}]). srp_anon_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <-[{srp_anon, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}]])]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], + []). srp_dss_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <- [{srp_dss, '3des_ede_cbc', sha}, - {srp_dss, aes_128_cbc, sha}, - {srp_dss, aes_256_cbc, sha}]])]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + [{key_exchange, + fun(srp_dss) -> + true; + (_) -> + false + end}]). rc4_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:rc4_suites(Version))]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). des_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:des_suites(Version))]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, @@ -1309,6 +1300,32 @@ cipher_restriction(Config0) -> Config0 end. +openssl_dsa_support() -> + case os:cmd("openssl version") of + "LibreSSL 2.6.1" ++ _ -> + true; + "LibreSSL 2.6.2" ++ _ -> + true; + "LibreSSL 2.6" ++ _ -> + false; + "LibreSSL 2.4" ++ _ -> + true; + "LibreSSL 2.3" ++ _ -> + true; + "LibreSSL 2.2" ++ _ -> + true; + "LibreSSL 2.1" ++ _ -> + true; + "LibreSSL 2.0" ++ _ -> + true; + "LibreSSL" ++ _ -> + false; + "OpenSSL 1.0.1" ++ Rest -> + hd(Rest) >= s; + _ -> + true + end. + check_sane_openssl_version(Version) -> case supports_ssl_tls_version(Version) of true -> @@ -1387,7 +1404,9 @@ filter_suites(Ciphers0, AtomVersion) -> Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:psk_suites_anon(Version) ++ ssl_cipher:srp_suites() + ++ ssl_cipher:srp_suites_anon() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), Supported2 = [ssl_cipher:erl_suite_definition(S) || S <- Supported1], diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index bbb925e742..f091c8786e 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -143,10 +143,15 @@ init_per_suite(Config0) -> try crypto:start() of ok -> ssl_test_lib:clean_start(), - - Config1 = ssl_test_lib:make_rsa_cert(Config0), - Config2 = ssl_test_lib:make_dsa_cert(Config1), - ssl_test_lib:cipher_restriction(Config2) + Config = + case ssl_test_lib:openssl_dsa_support() of + true -> + Config1 = ssl_test_lib:make_rsa_cert(Config0), + ssl_test_lib:make_dsa_cert(Config1); + false -> + ssl_test_lib:make_rsa_cert(Config0) + end, + ssl_test_lib:cipher_restriction(Config) catch _:_ -> {skip, "Crypto did not start"} end @@ -199,15 +204,27 @@ init_per_testcase(expired_session, Config) -> ssl:start(), Config; -init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs; - TestCase == ciphers_dsa_signed_certs -> - ct:timetrap({seconds, 90}), - special_init(TestCase, Config); - +init_per_testcase(TestCase, Config) when + TestCase == ciphers_dsa_signed_certs; + TestCase == erlang_client_openssl_server_dsa_cert; + TestCase == erlang_server_openssl_client_dsa_cert; + TestCase == erlang_client_openssl_server_dsa_cert; + TestCase == erlang_server_openssl_client_dsa_cert -> + case ssl_test_lib:openssl_dsa_support() of + true -> + special_init(TestCase, Config); + false -> + {skip, "DSA not supported by OpenSSL"} + end; init_per_testcase(TestCase, Config) -> ct:timetrap({seconds, 35}), special_init(TestCase, Config). +special_init(TestCase, Config) when + TestCase == ciphers_rsa_signed_certs; + TestCase == ciphers_dsa_signed_certs-> + ct:timetrap({seconds, 90}), + Config; special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_renegotiate; TestCase == erlang_client_openssl_server_nowrap_seqnum; @@ -1016,7 +1033,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), consume_port_exit(OpenSslPort), - ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- ssl2_erlang_server_openssl_client_comp() -> diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml index ea23cca2ee..33f29f38da 100644 --- a/lib/stdlib/doc/src/assert_hrl.xml +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -93,7 +93,7 @@ erlc -DNOASSERT=true *.erl</code> <taglist> <tag><c>assert(BoolExpr)</c></tag> <item></item> - <tag><c>URKAassert(BoolExpr, Comment)</c></tag> + <tag><c>assert(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>true</c>.</p> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 576959b1c8..51e35cd2df 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -963,11 +963,11 @@ ets:is_compiled_ms(Broken).</code> <func> <name name="match_spec_run" arity="2"/> <fsummary>Perform matching, using a compiled match specification on a - list of tuples.</fsummary> + list of terms.</fsummary> <desc> <p>Executes the matching specified in a compiled <seealso marker="#match_spec">match specification</seealso> on a list - of tuples. Term <c><anno>CompiledMatchSpec</anno></c> is to be + of terms. Term <c><anno>CompiledMatchSpec</anno></c> is to be the result of a call to <seealso marker="#match_spec_compile/1"> <c>match_spec_compile/1</c></seealso> and is hence the internal representation of the match specification one wants to use.</p> @@ -985,7 +985,7 @@ Table = ets:new... MatchSpec = ... % The following call... ets:match_spec_run(ets:tab2list(Table), -ets:match_spec_compile(MatchSpec)), + ets:match_spec_compile(MatchSpec)), % ...gives the same result as the more common (and more efficient) ets:select(Table, MatchSpec),</code> <note> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index a7caa71dcb..574f488e91 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -543,7 +543,23 @@ handle_event(_, _, State, Data) -> <name name="event_type"/> <desc> <p> - External events are of three types: + There are 3 categories of events: + <seealso marker="#type-external_event_type">external</seealso>, + <seealso marker="#type-timeout_event_type">timeout</seealso>, + and <c>internal</c>. + </p> + <p> + <c>internal</c> events can only be generated by the + state machine itself through the state transition action + <seealso marker="#type-action"><c>next_event</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="external_event_type"/> + <desc> + <p> + External events are of 3 types: <c>{call,<anno>From</anno>}</c>, <c>cast</c>, or <c>info</c>. <seealso marker="#call/2">Calls</seealso> (synchronous) and @@ -551,12 +567,17 @@ handle_event(_, _, State, Data) -> originate from the corresponding API functions. For calls, the event contains whom to reply to. Type <c>info</c> originates from regular process messages sent - to the <c>gen_statem</c>. The state machine - implementation can, in addition to the above, - generate - <seealso marker="#type-event_type"><c>events of types</c></seealso> - <c>timeout</c>, <c>{timeout,<anno>Name</anno>}</c>, - <c>state_timeout</c>, and <c>internal</c> to itself. + to the <c>gen_statem</c>. + </p> + </desc> + </datatype> + <datatype> + <name name="timeout_event_type"/> + <desc> + <p> + There are 3 types of timeout events that the state machine + can generate for itself with the corresponding + <seealso marker="#type-timeout_action">timeout_action()</seealso>s. </p> </desc> </datatype> @@ -1026,6 +1047,25 @@ handle_event(_, _, State, Data) -> for this state transition. </p> </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="timeout_action"/> + <desc> + <p> + These state transition actions can be invoked by + returning them from the + <seealso marker="#state callback">state callback</seealso>, from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or by giving them to + <seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>. + </p> + <p> + These timeout actions sets timeout + <seealso marker="#type-transition_option">transition options</seealso>. + </p> + <taglist> <tag><c>Timeout</c></tag> <item> <p> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 31d0d499e3..b8e48bff6c 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -1194,21 +1194,21 @@ skip_else(_Else, From, St, Sis) -> %% macro_expansion(Tokens, Anno) %% Extract the macro parameters and the expansion from a macro definition. -macro_pars([{')',_Lp}, {',',Ld}|Ex], Args) -> - {ok, {lists:reverse(Args), macro_expansion(Ex, Ld)}}; -macro_pars([{var,_,Name}, {')',_Lp}, {',',Ld}|Ex], Args) -> +macro_pars([{')',_Lp}, {',',_Ld}=Comma|Ex], Args) -> + {ok, {lists:reverse(Args), macro_expansion(Ex, Comma)}}; +macro_pars([{var,_,Name}, {')',_Lp}, {',',_Ld}=Comma|Ex], Args) -> false = lists:member(Name, Args), %Prolog is nice - {ok, {lists:reverse([Name|Args]), macro_expansion(Ex, Ld)}}; + {ok, {lists:reverse([Name|Args]), macro_expansion(Ex, Comma)}}; macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> false = lists:member(Name, Args), macro_pars(Ts, [Name|Args]). -macro_expansion([{')',_Lp},{dot,_Ld}], _Anno0) -> []; -macro_expansion([{dot,_}=Dot], _Anno0) -> +macro_expansion([{')',_Lp},{dot,_Ld}], _T0) -> []; +macro_expansion([{dot,_}=Dot], _T0) -> throw({error,loc(Dot),missing_parenthesis}); -macro_expansion([T|Ts], _Anno0) -> +macro_expansion([T|Ts], _T0) -> [T|macro_expansion(Ts, T)]; -macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). +macro_expansion([], T0) -> throw({error,loc(T0),premature_end}). %% expand_macros(Tokens, St) %% expand_macro(Tokens, MacroToken, RestTokens) diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 1db004c91e..42fa8ede92 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -277,7 +277,7 @@ match_spec_compile(_) -> erlang:nif_error(undef). -spec match_spec_run_r(List, CompiledMatchSpec, list()) -> list() when - List :: [tuple()], + List :: [term()], CompiledMatchSpec :: comp_match_spec(). match_spec_run_r(_, _, _) -> @@ -517,7 +517,7 @@ update_element(_, _, _) -> -opaque comp_match_spec() :: reference(). -spec match_spec_run(List, CompiledMatchSpec) -> list() when - List :: [tuple()], + List :: [term()], CompiledMatchSpec :: comp_match_spec(). match_spec_run(List, CompiledMS) -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index a9b98911e2..73e4457bd0 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -125,7 +125,8 @@ | {'logfile', string()}. -type option() :: {'timeout', timeout()} | {'debug', [debug_flag()]} - | {'spawn_opt', [proc_lib:spawn_option()]}. + | {'spawn_opt', [proc_lib:spawn_option()]} + | {'hibernate_after', timeout()}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 96a53426e2..8c7db65563 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -198,7 +198,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' fsm %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{debug, [Flag]}] diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 1110d18af6..b1d99e2e14 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016-2017. All Rights Reserved. +%% Copyright Ericsson AB 2016-2018. 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. @@ -78,9 +78,11 @@ -type data() :: term(). -type event_type() :: - {'call',From :: from()} | 'cast' | 'info' | - 'timeout' | {'timeout', Name :: term()} | 'state_timeout' | - 'internal'. + external_event_type() | timeout_event_type() | 'internal'. +-type external_event_type() :: + {'call',From :: from()} | 'cast' | 'info'. +-type timeout_event_type() :: + 'timeout' | {'timeout', Name :: term()} | 'state_timeout'. -type callback_mode_result() :: callback_mode() | [callback_mode() | state_enter()]. @@ -138,7 +140,9 @@ -type enter_action() :: 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | - %% + timeout_action() | + reply_action(). +-type timeout_action() :: (Timeout :: event_timeout()) | % {timeout,Timeout} {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | @@ -159,9 +163,7 @@ {'state_timeout', % Set the state_timeout option Time :: state_timeout(), EventContent :: term(), - Options :: (timeout_option() | [timeout_option()])} | - %% - reply_action(). + Options :: (timeout_option() | [timeout_option()])}. -type reply_action() :: {'reply', % Reply to a caller From :: from(), Reply :: term()}. @@ -320,7 +322,13 @@ handle_event/4 % For callback_mode() =:= handle_event_function ]). + + %% Type validation functions +-compile( + {inline, + [callback_mode/1, state_enter/1, from/1, event_type/1]}). +%% callback_mode(CallbackMode) -> case CallbackMode of state_functions -> true; @@ -328,6 +336,14 @@ callback_mode(CallbackMode) -> _ -> false end. %% +state_enter(StateEnter) -> + case StateEnter of + state_enter -> + true; + _ -> + false + end. +%% from({Pid,_}) when is_pid(Pid) -> true; from(_) -> false. %% @@ -351,6 +367,48 @@ event_type(Type) -> STACKTRACE(), try throw(ok) catch _ -> erlang:get_stacktrace() end). +-define(not_sys_debug, []). +%% +%% This is a macro to only evaluate arguments if Debug =/= []. +%% Debug is evaluated multiple times. +-define( + sys_debug(Debug, NameState, Entry), + case begin Debug end of + ?not_sys_debug -> + begin Debug end; + _ -> + sys_debug(begin Debug end, begin NameState end, begin Entry end) + end). + +-record(state, + {callback_mode = undefined :: callback_mode() | undefined, + state_enter = false :: boolean(), + module :: atom(), + name :: atom(), + state :: term(), + data :: term(), + postponed = [] :: [{event_type(),term()}], + %% + timer_refs = #{} :: % timer ref => the timer's event type + #{reference() => timeout_event_type()}, + timer_types = #{} :: % timer's event type => timer ref + #{timeout_event_type() => reference()}, + cancel_timers = 0 :: non_neg_integer(), + %% We add a timer to both timer_refs and timer_types + %% when we start it. When we request an asynchronous + %% timer cancel we remove it from timer_types. When + %% the timer cancel message arrives we remove it from + %% timer_refs. + %% + hibernate = false :: boolean(), + hibernate_after = infinity :: timeout()}). + +-record(trans_opts, + {hibernate = false, + postpone = false, + timeouts_r = [], + next_events_r = []}). + %%%========================================================================== %%% API @@ -422,6 +480,10 @@ stop(ServerRef, Reason, Timeout) -> %% Send an event to a state machine that arrives with type 'event' -spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); cast({global,Name}, Msg) -> try global:send(Name, wrap_cast(Msg)) of _ -> ok @@ -435,10 +497,6 @@ cast({via,RegMod,Name}, Msg) -> _:_ -> ok end; cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_atom(ServerRef) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_pid(ServerRef) -> send(ServerRef, wrap_cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that @@ -455,75 +513,18 @@ call(ServerRef, Request) -> {'clean_timeout',T :: timeout()} | {'dirty_timeout',T :: timeout()}) -> Reply :: term(). +call(ServerRef, Request, infinity = T = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {dirty_timeout, T} = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {clean_timeout, infinity = T} = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {clean_timeout, T} = Timeout) -> + call_clean(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {_, _} = Timeout) -> + erlang:error(badarg, [ServerRef,Request,Timeout]); call(ServerRef, Request, Timeout) -> - case parse_timeout(Timeout) of - {dirty_timeout,T} -> - try gen:call(ServerRef, '$gen_call', Request, T) of - {ok,Reply} -> - Reply - catch - Class:Reason -> - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - erlang:get_stacktrace()) - end; - {clean_timeout,T} -> - %% Call server through proxy process to dodge any late reply - Ref = make_ref(), - Self = self(), - Pid = spawn( - fun () -> - Self ! - try gen:call( - ServerRef, '$gen_call', Request, T) of - Result -> - {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason, - erlang:get_stacktrace()} - end - end), - Mref = monitor(process, Pid), - receive - {Ref,Result} -> - demonitor(Mref, [flush]), - case Result of - {ok,Reply} -> - Reply - end; - {Ref,Class,Reason,Stacktrace} -> - demonitor(Mref, [flush]), - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - Stacktrace); - {'DOWN',Mref,_,_,Reason} -> - %% There is a theoretical possibility that the - %% proxy process gets killed between try--of and ! - %% so this clause is in case of that - exit(Reason) - end; - Error when is_atom(Error) -> - erlang:error(Error, [ServerRef,Request,Timeout]) - end. - -parse_timeout(Timeout) -> - case Timeout of - {clean_timeout,infinity} -> - {dirty_timeout,infinity}; - {clean_timeout,_} -> - Timeout; - {dirty_timeout,_} -> - Timeout; - {_,_} -> - %% Be nice and throw a badarg for speling errors - badarg; - infinity -> - {dirty_timeout,infinity}; - T -> - {clean_timeout,T} - end. + call_clean(ServerRef, Request, Timeout, Timeout). %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. @@ -532,6 +533,7 @@ reply({reply,From,Reply}) -> reply(Replies) when is_list(Replies) -> replies(Replies). %% +-compile({inline, [reply/2]}). -spec reply(From :: from(), Reply :: term()) -> ok. reply({To,Tag}, Reply) when is_pid(To) -> Msg = {Tag,Reply}, @@ -581,9 +583,59 @@ enter_loop(Module, Opts, State, Data, Server, Actions) -> %%--------------------------------------------------------------------------- %% API helpers +-compile({inline, [wrap_cast/1]}). wrap_cast(Event) -> {'$gen_cast',Event}. +call_dirty(ServerRef, Request, Timeout, T) -> + try gen:call(ServerRef, '$gen_call', Request, T) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end. + +call_clean(ServerRef, Request, Timeout, T) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + replies([{reply,From,Reply}|Replies]) -> reply(From, Reply), replies(Replies); @@ -608,60 +660,28 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - HibernateAfterTimeout = gen:hibernate_after(Opts), - Events = [], - P = [], + HibernateAfterTimeout = gen:hibernate_after(Opts), + Events = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged - NewActions = - if - is_list(Actions) -> - Actions ++ [{postpone,false}]; - true -> - [Actions,{postpone,false}] - end, - TimerRefs = #{}, - %% Key: timer ref - %% Value: the timer type i.e the timer's event type - %% - TimerTypes = #{}, - %% Key: timer type i.e the timer's event type - %% Value: timer ref - %% - %% We add a timer to both timer_refs and timer_types - %% when we start it. When we request an asynchronous - %% timer cancel we remove it from timer_types. When - %% the timer cancel message arrives we remove it from - %% timer_refs. - %% - Hibernate = false, - CancelTimers = 0, - S = #{ - callback_mode => undefined, - state_enter => false, - module => Module, - name => Name, - state => State, - data => Data, - postponed => P, - %% - %% The following fields are finally set from to the arguments to - %% loop_event_actions/9 when it finally loops back to loop/3 - %% in loop_event_result/11 - timer_refs => TimerRefs, - timer_types => TimerTypes, - hibernate => Hibernate, - hibernate_after => HibernateAfterTimeout, - cancel_timers => CancelTimers - }, - NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), + NewActions = listify(Actions) ++ [{postpone,false}], + S = + #state{ + module = Module, + name = Name, + state = State, + data = Data, + hibernate_after = HibernateAfterTimeout}, + CallEnter = true, + NewDebug = ?sys_debug(Debug, {Name,State}, {enter,Event,State}), case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> loop_event_actions( Parent, NewDebug, NewS, - Events, Event, State, Data, NewActions, true); - {Class,Reason,Stacktrace} -> + Events, Event, State, Data, #trans_opts{}, + NewActions, CallEnter); + [Class,Reason,Stacktrace] -> terminate( Class, Reason, Stacktrace, NewDebug, S, [Event|Events]) @@ -686,10 +706,8 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> proc_lib:init_ack(Starter, {error,Reason}), error_info( Class, Reason, Stacktrace, - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), erlang:raise(Class, Reason, Stacktrace) end. @@ -719,10 +737,8 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, {error,Error}), error_info( error, Error, ?STACKTRACE(), - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), exit(Error) end. @@ -736,9 +752,10 @@ system_terminate(Reason, _Parent, Debug, S) -> terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( - #{module := Module, - state := State, - data := Data} = S, + #state{ + module = Module, + state = State, + data = Data} = S, _Mod, OldVsn, Extra) -> case try Module:code_change(OldVsn, State, Data, Extra) @@ -748,29 +765,31 @@ system_code_change( of {ok,NewState,NewData} -> {ok, - S#{callback_mode := undefined, - state := NewState, - data := NewData}}; + S#state{ + callback_mode = undefined, + state = NewState, + data = NewData}}; {ok,_} = Error -> error({case_clause,Error}); Error -> Error end. -system_get_state(#{state := State, data := Data}) -> +system_get_state(#state{state = State, data = Data}) -> {ok,{State,Data}}. system_replace_state( StateFun, - #{state := State, - data := Data} = S) -> + #state{ + state = State, + data = Data} = S) -> {NewState,NewData} = Result = StateFun({State,Data}), - {ok,Result,S#{state := NewState, data := NewData}}. + {ok,Result,S#state{state = NewState, data = NewData}}. format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P} = S]) -> + #state{name = Name, postponed = P} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -789,6 +808,9 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- +sys_debug(Debug, NameState, Entry) -> + sys:handle_debug(Debug, fun print_event/3, NameState, Entry). + print_event(Dev, {in,Event}, {Name,State}) -> io:format( Dev, "*DBG* ~tp receive ~ts in state ~tp~n", @@ -821,15 +843,6 @@ event_string(Event) -> io_lib:format("~tw ~tp", [EventType,EventContent]) end. -sys_debug(Debug, #{name := Name}, State, Entry) -> - case Debug of - [] -> - Debug; - _ -> - sys:handle_debug( - Debug, fun print_event/3, {Name,State}, Entry) - end. - %%%========================================================================== %%% Internal callbacks @@ -844,14 +857,16 @@ wakeup_from_hibernate(Parent, Debug, S) -> %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 -loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) -> +loop(Parent, Debug, #state{hibernate = true, cancel_timers = 0} = S) -> loop_hibernate(Parent, Debug, S); loop(Parent, Debug, S) -> loop_receive(Parent, Debug, S). loop_hibernate(Parent, Debug, S) -> + %% %% Does not return but restarts process at %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + %% proc_lib:hibernate( ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), error( @@ -859,17 +874,18 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> +loop_receive( + Parent, Debug, #state{hibernate_after = HibernateAfterTimeout} = S) -> + %% receive Msg -> case Msg of {system,Pid,Req} -> - #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, - Hibernate); + S#state.hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple therefore %% not an event but this will stand out @@ -877,9 +893,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> Q = [EXIT], terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + timer_types = TimerTypes} = S, case TimerRefs of #{TimerRef := TimerType} -> %% We know of this timer; is it a running @@ -889,7 +905,6 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> #{TimerType := TimerRef} -> %% The timer type maps back to this %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, %% Unregister the triggered timeout NewTimerRefs = maps:remove(TimerRef, TimerRefs), @@ -897,11 +912,10 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerType, TimerTypes), loop_receive_result( Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + S#state{ + timer_refs = NewTimerRefs, + timer_types = NewTimerTypes}, + TimerType, TimerMsg); _ -> %% This was a late timeout message %% from timer being cancelled, so @@ -911,14 +925,13 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> end; _ -> %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; {cancel_timer,TimerRef,_} -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + cancel_timers = CancelTimers, + hibernate = Hibernate} = S, case TimerRefs of #{TimerRef := _} -> %% We must have requested a cancel @@ -928,9 +941,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerRef, TimerRefs), NewCancelTimers = CancelTimers - 1, NewS = - S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, + S#state{ + timer_refs = NewTimerRefs, + cancel_timers = NewCancelTimers}, if Hibernate =:= true, NewCancelTimers =:= 0 -> %% No more cancel_timer msgs to expect; @@ -942,238 +955,631 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> _ -> %% Not our cancel_timer msg; %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; _ -> %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> - {{call,From},Request}; - {'$gen_cast',E} -> - {cast,E}; - _ -> - {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + case Msg of + {'$gen_call',From,Request} -> + loop_receive_result( + Parent, Debug, S, {call,From}, Request); + {'$gen_cast',Cast} -> + loop_receive_result(Parent, Debug, S, cast, Cast); + _ -> + loop_receive_result(Parent, Debug, S, info, Msg) + end end after HibernateAfterTimeout -> loop_hibernate(Parent, Debug, S) end. +loop_receive_result(Parent, ?not_sys_debug, S, Type, Content) -> + %% Here is the queue of not yet handled events created + Events = [], + loop_event(Parent, ?not_sys_debug, S, Events, Type, Content); loop_receive_result( - Parent, Debug, - #{state := State, - timer_types := TimerTypes, cancel_timers := CancelTimers} = S, - Hibernate, Event) -> - %% From now the 'hibernate' field in S is invalid - %% and will be restored when looping back - %% in loop_event_result/11 - NewDebug = sys_debug(Debug, S, State, {in,Event}), + Parent, Debug, #state{name = Name, state = State} = S, Type, Content) -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), %% Here is the queue of not yet handled events created Events = [], - %% Cancel any running event timer - case - cancel_timer_by_type(timeout, TimerTypes, CancelTimers) - of - {_,CancelTimers} -> - %% No timer cancelled - loop_event(Parent, NewDebug, S, Events, Event, Hibernate); - {NewTimerTypes,NewCancelTimers} -> - %% The timer is removed from NewTimerTypes but - %% remains in TimerRefs until we get - %% the cancel_timer msg - NewS = - S#{ - timer_types := NewTimerTypes, - cancel_timers := NewCancelTimers}, - loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate) - end. + loop_event(Parent, NewDebug, S, Events, Type, Content). %% Entry point for handling an event, received or enqueued loop_event( + Parent, Debug, #state{hibernate = Hibernate} = S, + Events, Type, Content) -> + %% + case Hibernate of + true -> + %% + %% If (this old) Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened. + %% + _ = garbage_collect(), + loop_event_state_function( + Parent, Debug, S, Events, Type, Content); + false -> + loop_event_state_function( + Parent, Debug, S, Events, Type, Content) + end. + +%% Call the state function +loop_event_state_function( Parent, Debug, - #{state := State, data := Data} = S, - Events, {Type,Content} = Event, Hibernate) -> + #state{state = State, data = Data} = S, + Events, Type, Content) -> + %% + %% The field 'hibernate' in S is now invalid and will be + %% restored when looping back to loop/3 or loop_event/6. %% - %% If (this old) Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there were - %% events in queue, so we do what the user - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), + Event = {Type,Content}, + TransOpts = false, case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> - {NextState,NewData,Actions,EnterCall} = - parse_event_result( - true, Debug, NewS, - Events, Event, State, Data, Result), - loop_event_actions( - Parent, Debug, NewS, - Events, Event, NextState, NewData, Actions, EnterCall); - {Class,Reason,Stacktrace} -> + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, State, Data, TransOpts, Result); + [Class,Reason,Stacktrace] -> terminate( - Class, Reason, Stacktrace, Debug, S, - [Event|Events]) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -loop_event_actions( - Parent, Debug, - #{state := State, state_enter := StateEnter} = S, - Events, Event, NextState, NewData, - Actions, EnterCall) -> - %% Hibernate is reborn here as false being - %% the default value from parse_actions/4 - case parse_actions(Debug, S, State, Actions) of - {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> - if - StateEnter, EnterCall -> - loop_event_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - true -> - loop_event_result( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; - {Class,Reason,Stacktrace} -> +%% Make a state enter call to the state function +loop_event_state_enter( + Parent, Debug, #state{state = PrevState} = S, + Events, Event, NextState, NewData, TransOpts) -> + %% + case call_state_function(S, enter, PrevState, NextState, NewData) of + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, NextState, NewData, TransOpts, Result); + [Class,Reason,Stacktrace] -> terminate( - Class, Reason, Stacktrace, Debug, S, - [Event|Events]) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -loop_event_enter( - Parent, Debug, #{state := State} = S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - case call_state_function(S, enter, State, NextState, NewData) of - {ok,Result,NewS} -> - case parse_event_result( - false, Debug, NewS, - Events, Event, NextState, NewData, Result) of - {_,NewerData,Actions,EnterCall} -> - loop_event_enter_actions( - Parent, Debug, NewS, - Events, Event, NextState, NewerData, - Hibernate, TimeoutsR, Postpone, NextEventsR, - Actions, EnterCall) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, - S#{ - state := NextState, - data := NewData, - hibernate := Hibernate}, - [Event|Events]) +%% Process the result from the state function. +%% When TransOpts =:= false it was a state function call, +%% otherwise it is an option tuple and it was a state enter call. +%% +loop_event_result( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, Result) -> + %% + case Result of + {next_state,State,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {next_state,NextState,NewData} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + [], true); + {next_state,State,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + {next_state,NextState,NewData,Actions} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + Actions, true); + %% + {keep_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {keep_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + %% + keep_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], false); + {keep_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, false); + %% + {repeat_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], true); + {repeat_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, true); + %% + repeat_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], true); + {repeat_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, true); + %% + stop -> + terminate( + exit, normal, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason,NewData} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + %% + {stop_and_reply,Reason,Replies} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + {stop_and_reply,Reason,Replies,NewData} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + %% + _ -> + terminate( + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]) end. -loop_event_enter_actions( - Parent, Debug, #{state_enter := StateEnter} = S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, - Actions, EnterCall) -> - case - parse_enter_actions( - Debug, S, NextState, Actions, Hibernate, TimeoutsR) - of - {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - if - StateEnter, EnterCall -> - loop_event_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR); - true -> - loop_event_result( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, - S#{ - state := NextState, - data := NewData, - hibernate := Hibernate}, - [Event|Events]) +-compile({inline, [hibernate_in_trans_opts/1]}). +hibernate_in_trans_opts(false) -> + (#trans_opts{})#trans_opts.hibernate; +hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> + Hibernate. + +%% Ensure that Actions are a list +loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + loop_event_actions_list( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + listify(Actions), CallEnter). + +%% Process actions from the state function +loop_event_actions_list( + Parent, Debug, #state{state_enter = StateEnter} = S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + %% + case parse_actions(TransOpts, Debug, S, Actions) of + {NewDebug,NewTransOpts} + when StateEnter, CallEnter -> + loop_event_state_enter( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + {NewDebug,NewTransOpts} -> + loop_event_done( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + [Class,Reason,Stacktrace,NewDebug] -> + terminate( + Class, Reason, Stacktrace, NewDebug, + S#state{ + state = NextState, + data = NewerData, + hibernate = TransOpts#trans_opts.hibernate}, + [Event|Events]) end. -loop_event_result( +parse_actions(false, Debug, S, Actions) -> + parse_actions(true, Debug, S, Actions, #trans_opts{}); +parse_actions(TransOpts, Debug, S, Actions) -> + parse_actions(false, Debug, S, Actions, TransOpts). +%% +parse_actions(_StateCall, Debug, _S, [], TransOpts) -> + {Debug,TransOpts}; +parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + parse_actions_reply( + StateCall, Debug, S, Actions, TransOpts, From, Reply); + %% + %% Actions that set options + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = NewHibernate}); + hibernate -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = true}); + %% + {postpone,NewPostpone} when not NewPostpone orelse StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = NewPostpone}); + postpone when StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = true}); + %% + {next_event,Type,Content} -> + parse_actions_next_event( + StateCall, Debug, S, Actions, TransOpts, Type, Content); + %% + _ -> + parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, Action) + end. + +parse_actions_reply( + StateCall, ?not_sys_debug, S, Actions, TransOpts, + From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + parse_actions(StateCall, ?not_sys_debug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_reply( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + NewDebug = sys_debug(Debug, {Name,State}, {out,Reply,From}), + parse_actions(StateCall, NewDebug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_next_event( + StateCall, ?not_sys_debug, S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, ?not_sys_debug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_next_event( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, NewDebug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> + %% + case classify_timer(Time, listify(TimerOpts)) of + absolute -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, AbsoluteTimeout); + relative -> + RelativeTimeout = {TimerType,Time,TimerMsg}, + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,AbsoluteTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {_,Time,_} = RelativeTimeout) -> + case classify_timer(Time, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,RelativeTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + Timeout) -> + case classify_timer(Timeout, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, TransOpts, Timeout); + badarg -> + [error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout_add( + StateCall, Debug, S, Actions, + #trans_opts{timeouts_r = TimeoutsR} = TransOpts, Timeout) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{timeouts_r = [Timeout|TimeoutsR]}). + +%% Do the state transition +loop_event_done( + Parent, ?not_sys_debug, + #state{postponed = P} = S, + Events, Event, NextState, NewData, + #trans_opts{ + postpone = Postpone, hibernate = Hibernate, + timeouts_r = [], next_events_r = []}) -> + %% + %% Optimize the simple cases + %% i.e no timer changes, no inserted events and no debug, + %% by duplicate stripped down code + %% + %% Fast path + %% + case Postpone of + true -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, [Event|P], NextState, NewData); + false -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, P, NextState, NewData) + end; +loop_event_done( Parent, Debug_0, - #{state := State, postponed := P_0, - timer_refs := TimerRefs_0, timer_types := TimerTypes_0, - cancel_timers := CancelTimers_0} = S_0, + #state{ + state = State, postponed = P_0, + timer_refs = TimerRefs_0, timer_types = TimerTypes_0, + cancel_timers = CancelTimers_0} = S, Events_0, Event_0, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) -> + #trans_opts{ + hibernate = Hibernate, timeouts_r = TimeoutsR, + postpone = Postpone, next_events_r = NextEventsR}) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {Debug_1,P_1} = % Move current event to postponed if Postpone + %% Full feature path + %% + [Debug_1|P_1] = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), - [Event_0|P_0]}; + [?sys_debug( + Debug_0, + {S#state.name,State}, + {postpone,Event_0,State}), + Event_0|P_0]; false -> - {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), - P_0} + [?sys_debug( + Debug_0, + {S#state.name,State}, + {consume,Event_0,State})|P_0] end, - {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = - %% Move all postponed events to queue and cancel the - %% state timeout if the state changes + {Events_2,P_2,Timers_2} = + %% Move all postponed events to queue, + %% cancel the event timer, + %% and cancel the state timeout if the state changes if NextState =:= State -> - {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; + {Events_0,P_1, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0})}; true -> {lists:reverse(P_1, Events_0), [], cancel_timer_by_type( - state_timeout, TimerTypes_0, CancelTimers_0)} - %% The state timer is removed from TimerTypes_1 - %% but remains in TimerRefs_0 until we get + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0}))} + %% The state timer is removed from TimerTypes + %% but remains in TimerRefs until we get %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = - %% Stop and start non-event timers - parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), + {TimerRefs_3,{TimerTypes_3,CancelTimers_3},TimeoutEvents} = + %% Stop and start timers + parse_timers(TimerRefs_0, Timers_2, TimeoutsR), %% Place next events last in reversed queue - Events_2R = lists:reverse(Events_1, NextEventsR), - %% Enqueue immediate timeout events and start event timer - Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R), - S_1 = - S_0#{ - state := NextState, - data := NewData, - postponed := P_2, - timer_refs := TimerRefs_2, - timer_types := TimerTypes_2, - cancel_timers := CancelTimers_2, - hibernate := Hibernate}, - case lists:reverse(Events_3R) of - [] -> - %% Get a new event - loop(Parent, Debug_1, S_1); - [Event|Events] -> + Events_3R = lists:reverse(Events_2, NextEventsR), + %% Enqueue immediate timeout events + Events_4R = prepend_timeout_events(TimeoutEvents, Events_3R), + loop_event_done( + Parent, Debug_1, + S#state{ + state = NextState, + data = NewData, + postponed = P_2, + timer_refs = TimerRefs_3, + timer_types = TimerTypes_3, + cancel_timers = CancelTimers_3, + hibernate = Hibernate}, + lists:reverse(Events_4R)). + +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, + #state{ + state = NextState, + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% Same state, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers})); +loop_event_done_fast( + Parent, Hibernate, + #state{state = NextState} = S, + Events, P, NextState, NewData) -> + %% + %% Same state + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + data = NewData, + postponed = P, + hibernate = Hibernate}, + Events); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{state_timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, state timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{} = S, + Events, P, NextState, NewData) -> + %% + %% State change, no timeout to automatically cancel + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = [], + hibernate = Hibernate}, + lists:reverse(P, Events)). +%% +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + {TimerTypes,CancelTimers}) -> + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = P, + timer_types = TimerTypes, + cancel_timers = CancelTimers, + hibernate = Hibernate}, + Events). + +loop_event_done(Parent, Debug, S, Q) -> + case Q of + [] -> + %% Get a new event + loop(Parent, Debug, S); + [{Type,Content}|Events] -> %% Loop until out of enqueued events - loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + loop_event(Parent, Debug, S, Events, Type, Content) end. %%--------------------------------------------------------------------------- %% Server loop helpers -call_callback_mode(#{module := Module} = S) -> +call_callback_mode(#state{module = Module} = S) -> try Module:callback_mode() of CallbackMode -> callback_mode_result(S, CallbackMode) @@ -1181,58 +1587,45 @@ call_callback_mode(#{module := Module} = S) -> CallbackMode -> callback_mode_result(S, CallbackMode); Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} + [Class,Reason,erlang:get_stacktrace()] end. callback_mode_result(S, CallbackMode) -> - case - parse_callback_mode( - if - is_atom(CallbackMode) -> - [CallbackMode]; - true -> - CallbackMode - end, undefined, false) - of - {undefined,_} -> - {error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()}; - {CBMode,StateEnter} -> - {ok, - S#{ - callback_mode := CBMode, - state_enter := StateEnter}} - end. - -parse_callback_mode([], CBMode, StateEnter) -> - {CBMode,StateEnter}; -parse_callback_mode([H|T], CBMode, StateEnter) -> + callback_mode_result( + S, CallbackMode, listify(CallbackMode), undefined, false). +%% +callback_mode_result(_S, CallbackMode, [], undefined, _StateEnter) -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()]; +callback_mode_result(S, _CallbackMode, [], CBMode, StateEnter) -> + S#state{callback_mode = CBMode, state_enter = StateEnter}; +callback_mode_result(S, CallbackMode, [H|T], CBMode, StateEnter) -> case callback_mode(H) of true -> - parse_callback_mode(T, H, StateEnter); + callback_mode_result(S, CallbackMode, T, H, StateEnter); false -> - case H of - state_enter -> - parse_callback_mode(T, CBMode, true); - _ -> - {undefined,StateEnter} + case state_enter(H) of + true -> + callback_mode_result(S, CallbackMode, T, CBMode, true); + false -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()] end - end; -parse_callback_mode(_, _CBMode, StateEnter) -> - {undefined,StateEnter}. + end. call_state_function( - #{callback_mode := undefined} = S, Type, Content, State, Data) -> + #state{callback_mode = undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> call_state_function(NewS, Type, Content, State, Data); Error -> Error end; call_state_function( - #{callback_mode := CallbackMode, module := Module} = S, + #state{callback_mode = CallbackMode, module = Module} = S, Type, Content, State, Data) -> try case CallbackMode of @@ -1243,333 +1636,108 @@ call_state_function( end of Result -> - {ok,Result,S} + {Result,S} catch Result -> - {ok,Result,S}; + {Result,S}; Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} - end. - - -%% Interpret all callback return variants -parse_event_result( - AllowStateChange, Debug, S, - Events, Event, State, Data, Result) -> - case Result of - stop -> - terminate( - exit, normal, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason,NewData} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events]); - %% - {stop_and_reply,Reason,Replies} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events], Replies); - {stop_and_reply,Reason,Replies,NewData} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events], Replies); - %% - {next_state,State,NewData} -> - {State,NewData,[],false}; - {next_state,NextState,NewData} when AllowStateChange -> - {NextState,NewData,[],true}; - {next_state,State,NewData,Actions} -> - {State,NewData,Actions,false}; - {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NextState,NewData,Actions,true}; - %% - {keep_state,NewData} -> - {State,NewData,[],false}; - {keep_state,NewData,Actions} -> - {State,NewData,Actions,false}; - keep_state_and_data -> - {State,Data,[],false}; - {keep_state_and_data,Actions} -> - {State,Data,Actions,false}; - %% - {repeat_state,NewData} -> - {State,NewData,[],true}; - {repeat_state,NewData,Actions} -> - {State,NewData,Actions,true}; - repeat_state_and_data -> - {State,Data,[],true}; - {repeat_state_and_data,Actions} -> - {State,Data,Actions,true}; - %% - _ -> - terminate( - error, - {bad_return_from_state_function,Result}, - ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]) - end. - - -parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> - Postpone = forbidden, - NextEventsR = forbidden, - parse_actions( - Debug, S, State, listify(Actions), - Hibernate, TimeoutsR, Postpone, NextEventsR). - -parse_actions(Debug, S, State, Actions) -> - Hibernate = false, - TimeoutsR = [infinity], %% Will cancel event timer - Postpone = false, - NextEventsR = [], - parse_actions( - Debug, S, State, listify(Actions), - Hibernate, TimeoutsR, Postpone, NextEventsR). -%% -parse_actions( - Debug, _S, _State, [], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; -parse_actions( - Debug, S, State, [Action|Actions], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - case Action of - %% Actual actions - {reply,From,Reply} -> - case from(From) of - true -> - NewDebug = do_reply(Debug, S, State, From, Reply), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()} - end; - %% - %% Actions that set options - {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - parse_actions( - Debug, S, State, Actions, - NewHibernate, TimeoutsR, Postpone, NextEventsR); - hibernate -> - NewHibernate = true, - parse_actions( - Debug, S, State, Actions, - NewHibernate, TimeoutsR, Postpone, NextEventsR); - %% - {postpone,NewPostpone} - when is_boolean(NewPostpone), Postpone =/= forbidden -> - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - postpone when Postpone =/= forbidden -> - NewPostpone = true, - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - %% - {next_event,Type,Content} -> - case event_type(Type) of - true when NextEventsR =/= forbidden -> - NewDebug = - sys_debug(Debug, S, State, {in,{Type,Content}}), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, - [{Type,Content}|NextEventsR]); - _ -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()} - end; - %% - {{timeout,_},_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {{timeout,_},_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {timeout,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {timeout,_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {state_timeout,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {state_timeout,_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - Time -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Time) + [Class,Reason,erlang:get_stacktrace()] end. -parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> - case Timeout of - {TimerType,Time,TimerMsg,TimerOpts} -> - case validate_timer_args(Time, listify(TimerOpts)) of - true -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - false -> - NewTimeout = {TimerType,Time,TimerMsg}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [NewTimeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - {_,Time,_} -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - Time -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end - end. -validate_timer_args(Time, Opts) -> - validate_timer_args(Time, Opts, false). +%% -> absolute | relative | badarg +classify_timer(Time, Opts) -> + classify_timer(Time, Opts, false). %% -validate_timer_args(Time, [], true) when is_integer(Time) -> - true; -validate_timer_args(Time, [], false) when is_integer(Time), Time >= 0 -> - false; -validate_timer_args(infinity, [], Abs) -> - Abs; -validate_timer_args(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> - validate_timer_args(Time, Opts, Abs); -validate_timer_args(_, [_|_], _) -> - error. +classify_timer(Time, [], Abs) -> + case Abs of + true when + is_integer(Time); + Time =:= infinity -> + absolute; + false when + is_integer(Time), 0 =< Time; + Time =:= infinity -> + relative; + _ -> + badarg + end; +classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> + classify_timer(Time, Opts, Abs); +classify_timer(_, Opts, _) when is_list(Opts) -> + badarg. %% Stop and start timers as well as create timeout zero events %% and pending event timer %% %% Stop and start timers non-event timers -parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). +parse_timers(TimerRefs, Timers, TimeoutsR) -> + parse_timers(TimerRefs, Timers, TimeoutsR, #{}, []). %% parse_timers( - TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; + TimerRefs, Timers, [], _Seen, TimeoutEvents) -> + %% + {TimerRefs,Timers,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], - Seen, TimeoutEvents) -> + TimerRefs, Timers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + %% case Timeout of {TimerType,Time,TimerMsg,TimerOpts} -> %% Absolute timer parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, listify(TimerOpts)); %% Relative timers below {TimerType,0,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, zero, TimerMsg, []); {TimerType,Time,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, []); 0 -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, zero, 0, []); Time -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, Time, Time, []) end. parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, TimerOpts) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents); + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, case Time of infinity -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, TimeoutEvents); zero -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later - TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, [TimeoutEvent|TimeoutEvents]); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, + [{TimerType,TimerMsg}|TimeoutEvents]); _ -> %% (Re)start the timer TimerRef = erlang:start_timer( Time, self(), TimerMsg, TimerOpts), - case TimerTypes of - #{TimerType := OldTimerRef} -> + case Timers of + {#{TimerType := OldTimerRef} = TimerTypes, + CancelTimers} -> %% Cancel the running timer cancel_timer(OldTimerRef), NewCancelTimers = CancelTimers + 1, @@ -1577,17 +1745,17 @@ parse_timers( %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); - #{} -> + {TimerTypes#{TimerType => TimerRef}, + NewCancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents); + {#{} = TimerTypes,CancelTimers} -> %% Insert the new timer into %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - CancelTimers, TimeoutsR, - NewSeen, TimeoutEvents) + {TimerTypes#{TimerType => TimerRef}, + CancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents) end end end. @@ -1609,6 +1777,8 @@ prepend_timeout_events([], EventsR) -> prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + %% Ignore since there are other events in queue + %% so they have cancelled the event timeout 0. prepend_timeout_events(TimeoutEvents, EventsR); prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %% Just prepend all others @@ -1619,23 +1789,28 @@ prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate( - Class, Reason, Stacktrace, Debug, - #{state := State} = S, Q, Replies) -> +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, - S, Q, listify(Replies), State). + Class, Reason, Stacktrace, Debug, S, Q, listify(Replies)). %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + Class, Reason, Stacktrace, Debug, S, Q, []) -> terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> case R of {reply,{_To,_Tag}=From,Reply} -> - NewDebug = do_reply(Debug, S, State, From, Reply), + reply(From, Reply), + NewDebug = + ?sys_debug( + Debug, + begin + #state{name = Name, state = State} = S, + {Name,State} + end, + {out,Reply,From}), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); + Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> terminate( error, @@ -1644,14 +1819,9 @@ do_reply_then_terminate( Debug, S, Q) end. -do_reply(Debug, S, State, From, Reply) -> - reply(From, Reply), - sys_debug(Debug, S, State, {out,Reply,From}). - - terminate( Class, Reason, Stacktrace, Debug, - #{module := Module, state := State, data := Data, postponed := P} = S, + #state{module = Module, state = State, data = Data} = S, Q) -> case erlang:function_exported(Module, terminate, 3) of true -> @@ -1662,7 +1832,7 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, S, Q, P, + C, R, ST, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug), erlang:raise(C, R, ST) @@ -1673,14 +1843,14 @@ terminate( _ = case Reason of normal -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); shutdown -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); {shutdown,_} -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); _ -> error_info( - Class, Reason, Stacktrace, S, Q, P, + Class, Reason, Stacktrace, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug) end, @@ -1691,12 +1861,18 @@ terminate( erlang:raise(Class, Reason, Stacktrace) end. +terminate_sys_debug(Debug, S, State, Reason) -> + ?sys_debug(Debug, {S#state.name,State}, {terminate,Reason}). + + error_info( Class, Reason, Stacktrace, - #{name := Name, - callback_mode := CallbackMode, - state_enter := StateEnter}, - Q, P, FmtData) -> + #state{ + name = Name, + callback_mode = CallbackMode, + state_enter = StateEnter, + postponed = P}, + Q, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1777,7 +1953,7 @@ error_info( %% Call Module:format_status/2 or return a default value format_status( Opt, PDict, - #{module := Module, state := State, data := Data}) -> + #state{module = Module, state = State, data = Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -1802,6 +1978,7 @@ format_status_default(Opt, State, Data) -> [{data,[{"State",StateData}]}] end. +-compile({inline, [listify/1]}). listify(Item) when is_list(Item) -> Item; listify(Item) -> @@ -1815,14 +1992,16 @@ listify(Item) -> %% %% Remove the timer from TimerTypes. %% When we get the cancel_timer msg we remove it from TimerRefs. -cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> +-compile({inline, [cancel_timer_by_type/2]}). +cancel_timer_by_type(TimerType, {TimerTypes,CancelTimers} = TT_CT) -> case TimerTypes of #{TimerType := TimerRef} -> - cancel_timer(TimerRef), + ok = erlang:cancel_timer(TimerRef, [{async,true}]), {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerTypes,CancelTimers} + TT_CT end. +-compile({inline, [cancel_timer/1]}). cancel_timer(TimerRef) -> ok = erlang:cancel_timer(TimerRef, [{async,true}]). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 9d447418f8..50bf959db5 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -149,7 +149,7 @@ fread(Chars, Format) -> -spec fread(Continuation, CharSpec, Format) -> Return when Continuation :: continuation() | [], - CharSpec :: string() | eof, + CharSpec :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 983e8d4566..319bff484e 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,7 +38,7 @@ -spec fread(Continuation, String, Format) -> Return when Continuation :: io_lib:continuation() | [], - String :: string(), + String :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: io_lib:continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 1f966411c5..0c578acf21 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,7 +38,9 @@ -export_type([dbg_opt/0]). --type name() :: pid() | atom() | {'global', atom()}. +-type name() :: pid() | atom() + | {'global', term()} + | {'via', module(), term()}. -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} | {'out', Msg :: _, To :: _} diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 915f478dfa..9123bf2f28 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -551,8 +551,8 @@ otp_8130(Config) when is_list(Config) -> "t() -> " " L = \"{ 34 , \\\"1\\\\x{AAA}\\\" , \\\"34\\\" , X . a , $\\\\x{AAA} }\", " " R = ?M({34,\"1\\x{aaa}\",\"34\",X.a,$\\x{aaa}})," - " Lt = erl_scan:string(L, 1, [unicode])," - " Rt = erl_scan:string(R, 1, [unicode])," + " Lt = erl_scan:string(L, 1)," + " Rt = erl_scan:string(R, 1)," " Lt = Rt, ok. ">>, ok}, diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index b76bece07f..272a71432a 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -3981,8 +3981,9 @@ non_latin1_module(Config) -> do_non_latin1_module(Mod) -> File = atom_to_list(Mod) ++ ".erl", - Forms = [{attribute,1,file,{File,1}}, - {attribute,1,module,Mod}, + L1 = erl_anno:new(1), + Forms = [{attribute,L1,file,{File,1}}, + {attribute,L1,module,Mod}, {eof,2}], error = compile:forms(Forms), {error,_,[]} = compile:forms(Forms, [return]), diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 808ba9b4c1..dda8d0a12e 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2017. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -1262,7 +1262,7 @@ parse_forms(Chars) -> parse_forms2([], _Cont, _Line, Forms) -> lists:reverse(Forms); parse_forms2(String, Cont0, Line, Forms) -> - case erl_scan:tokens(Cont0, String, Line, [unicode]) of + case erl_scan:tokens(Cont0, String, Line) of {done, {ok, Tokens, EndLine}, Chars} -> {ok, Form} = erl_parse:parse_form(Tokens), parse_forms2(Chars, [], EndLine, [Form | Forms]); @@ -1303,7 +1303,7 @@ parse_and_pp_expr(String, Indent, Options) -> erl_pp:expr(parse_expr(StringDot), Indent, Options). parse_expr(Chars) -> - {ok, Tokens, _} = erl_scan:string(Chars, 1, [unicode]), + {ok, Tokens, _} = erl_scan:string(Chars, 1), {ok, [Expr]} = erl_parse:parse_exprs(Tokens), Expr. diff --git a/lib/stdlib/test/escript_SUITE_data/unicode1 b/lib/stdlib/test/escript_SUITE_data/unicode1 index 351bb785e5..8dc9d450b8 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode1 +++ b/lib/stdlib/test/escript_SUITE_data/unicode1 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aaa}"/utf8>>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/escript_SUITE_data/unicode2 b/lib/stdlib/test/escript_SUITE_data/unicode2 index 495188f6f0..d0195b036c 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode2 +++ b/lib/stdlib/test/escript_SUITE_data/unicode2 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aa}">>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 05451a83fb..1a8260b041 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -6033,17 +6033,23 @@ etsmem() -> end}, {Mem,AllTabs}. -verify_etsmem({MemInfo,AllTabs}) -> + +verify_etsmem(MI) -> wait_for_test_procs(), + verify_etsmem(MI, 1). + +verify_etsmem({MemInfo,AllTabs}, Try) -> case etsmem() of {MemInfo,_} -> io:format("Ets mem info: ~p", [MemInfo]), - case MemInfo of - {ErlMem,EtsAlloc} when ErlMem == notsup; EtsAlloc == undefined -> + case {MemInfo, Try} of + {{ErlMem,EtsAlloc},_} when ErlMem == notsup; EtsAlloc == undefined -> %% Use 'erl +Mea max' to do more complete memory leak testing. {comment,"Incomplete or no mem leak testing"}; - _ -> - ok + {_, 1} -> + ok; + _ -> + {comment, "Transient memory discrepancy"} end; {MemInfo2, AllTabs2} -> @@ -6051,7 +6057,15 @@ verify_etsmem({MemInfo,AllTabs}) -> io:format("Actual: ~p", [MemInfo2]), io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]), io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]), - ct:fail("Failed memory check") + case Try < 2 of + true -> + io:format("\nThis discrepancy could be caused by an " + "inconsistent memory \"snapshot\"" + "\nTry again...\n", []), + verify_etsmem({MemInfo, AllTabs}, Try+1); + false -> + ct:fail("Failed memory check") + end end. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 86cf58566b..41ee3246f5 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -389,7 +389,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_fsm:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), @@ -1005,7 +1005,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {?MODULE, terminate}}, {ok, FSM} = gen_fsm:start(?MODULE, {state_data, State}, []), try - gen_fsm:stop(FSM), + ok = gen_fsm:stop(FSM), ct:fail(failed) catch exit:{undef, [{?MODULE, terminate, _, _}|_]} -> @@ -1201,7 +1201,7 @@ timeout({timeout,Ref,{timeout,Time}}, {From,Ref}) -> Cref = gen_fsm:start_timer(Time, cancel), Time4 = Time*4, receive after Time4 -> ok end, - gen_fsm:cancel_timer(Cref), + _= gen_fsm:cancel_timer(Cref), {next_state, timeout, {From,Ref2}}; timeout({timeout,Ref2,ok},{From,Ref2}) -> gen_fsm:reply(From, ok), diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2e9dc4d4fb..7d9561db24 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -346,7 +346,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_server:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), @@ -467,7 +467,7 @@ start_node(Name) -> %% After starting a slave, it takes a little while until global knows %% about it, even if nodes() includes it, so we make sure that global %% knows about it before registering something on all nodes. - global:sync(), + ok = global:sync(), N. call_remote1(Config) when is_list(Config) -> @@ -605,7 +605,7 @@ cast_fast(Config) when is_list(Config) -> cast_fast_messup() -> %% Register a false node: hopp@hostname unregister(erl_epmd), - erl_epmd:start_link(), + {ok, _} = erl_epmd:start_link(), {ok,S} = gen_tcp:listen(0, []), {ok,P} = inet:port(S), {ok,_Creation} = erl_epmd:register_node(hopp, P), @@ -1309,7 +1309,7 @@ do_call_with_huge_message_queue() -> {Time,ok} = tc(fun() -> calls(10000, Pid) end), - [self() ! {msg,N} || N <- lists:seq(1, 500000)], + _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)], erlang:garbage_collect(), {NewTime,ok} = tc(fun() -> calls(10000, Pid) end), io:format("Time for empty message queue: ~p", [Time]), @@ -1426,7 +1426,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {oc_server, terminate}}, {ok, Server} = gen_server:start(?MODULE, {state, State}, []), try - gen_server:stop(Server), + ok = gen_server:stop(Server), ct:fail(failed) catch exit:{undef, [{oc_server, terminate, [], _}|_]} -> @@ -1615,7 +1615,7 @@ handle_cast({From,delayed_cast,T}, _State) -> handle_cast(hibernate_now, _State) -> {noreply, [], hibernate}; handle_cast(hibernate_later, _State) -> - timer:send_after(1000,self(),hibernate_now), + {ok, _} = timer:send_after(1000,self(),hibernate_now), {noreply, []}; handle_cast({call_undef_fun, Mod, Fun}, State) -> Mod:Fun(), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index e2c73371cd..16e3dba969 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -714,7 +714,7 @@ p(Term, D) -> rp(Term, 1, 80, D). p(Term, Col, Ll, D) -> - rp(Term, Col, Ll, D, no_fun). + rp(Term, Col, Ll, D, none). rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, fun rfd/2). @@ -724,6 +724,8 @@ rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, RF) -> rp(Term, Col, Ll, D, ?MAXCS, RF). +rp(Term, Col, Ll, D, M, none) -> + rp(Term, Col, Ll, D, M, fun(_, _) -> no end); rp(Term, Col, Ll, D, M, RF) -> %% io:format("~n~n*** Col = ~p Ll = ~p D = ~p~n~p~n-->~n", %% [Col, Ll, D, Term]), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 217e8cc252..ca85314775 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2017. All Rights Reserved. +%% Copyright Ericsson AB 2004-2018. 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. @@ -561,9 +561,10 @@ otp_5226(Config) when is_list(Config) -> otp_5327(Config) when is_list(Config) -> "exception error: bad argument" = comm_err(<<"<<\"hej\":default>>.">>), + L1 = erl_anno:new(1), <<"abc">> = - erl_parse:normalise({bin,1,[{bin_element,1,{string,1,"abc"}, - default,default}]}), + erl_parse:normalise({bin,L1,[{bin_element,L1,{string,L1,"abc"}, + default,default}]}), [<<"abc">>] = scan(<<"<<(<<\"abc\">>):3/binary>>.">>), [<<"abc">>] = scan(<<"<<(<<\"abc\">>)/binary>>.">>), "exception error: bad argument" = @@ -576,9 +577,9 @@ otp_5327(Config) when is_list(Config) -> comm_err(<<"<<10:default>>.">>), [<<98,1:1>>] = scan(<<"<<3:3,5:6>>.">>), {'EXIT',{badarg,_}} = - (catch erl_parse:normalise({bin,1,[{bin_element,1,{integer,1,17}, - {atom,1,all}, - default}]})), + (catch erl_parse:normalise({bin,L1,[{bin_element,L1,{integer,L1,17}, + {atom,L1,all}, + default}]})), [<<-20/signed>>] = scan(<<"<<-20/signed>> = <<-20>>.">>), [<<-300:16/signed>>] = scan(<<"<<-300:16/signed>> = <<-300:16>>.">>), @@ -2784,7 +2785,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2797,7 +2798,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2809,7 +2810,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2821,7 +2822,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2940,7 +2941,7 @@ otp_14296(Config) when is_list(Config) -> end(), fun() -> - Port = open_port({spawn, "ls"}, [line]), + Port = open_port({spawn, "ls"}, [{line,1}]), KnownPort = erlang:port_to_list(Port), S = KnownPort ++ ".", R = KnownPort ++ ".\n", @@ -3012,7 +3013,7 @@ scan(B) -> scan(t(B), F). scan(S0, F) -> - case erl_scan:tokens([], S0, 1, [unicode]) of + case erl_scan:tokens([], S0, 1) of {done,{ok,Ts,_},S} -> [F(Ts) | scan(S, F)]; _Else -> diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 5bdfc60448..0c24375b91 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -371,7 +371,7 @@ <v>Serial = integer()</v> </type> <desc> - <p>Creates a process id with creation 0. Example:</p> + <p>Creates a process id with creation 0.</p> </desc> </func> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index 139b3d8a4a..d0152a4915 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -218,9 +218,11 @@ raw() -> call(raw). set(Option, Value) -> call({set, Option, Value}). set({Option, Value}) -> call({set, Option, Value}). save(Filename) -> call({save, Filename}). -load(Filename) -> ok = start_internal(), call({load, Filename}). +load(Filename) -> call({load, Filename}). -call(Msg) -> gen_server:call(?MODULE, Msg, infinity). +call(Msg) -> + ok = start_internal(), + gen_server:call(?MODULE, Msg, infinity). %% -------------------------------------------------------------------- %% %% @@ -237,7 +239,6 @@ apply(Fun) when is_function(Fun) -> lcnt:apply(Fun, []). apply(Fun, As) when is_function(Fun) -> - ok = start_internal(), Opt = lcnt:rt_opt({copy_save, true}), lcnt:clear(), Res = erlang:apply(Fun, As), @@ -943,7 +944,7 @@ print_state_information(#state{locks = Locks} = State) -> print(kv("#tries", s(Stats#stats.tries))), print(kv("#colls", s(Stats#stats.colls))), print(kv("wait time", s(Stats#stats.time) ++ " us" ++ " ( " ++ s(Stats#stats.time/1000000) ++ " s)")), - print(kv("percent of duration", s(Stats#stats.time/State#state.duration*100) ++ " %")), + print(kv("percent of duration", s(percent(Stats#stats.time, State#state.duration)) ++ " %")), ok. diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index 146c915087..a79572a742 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -30,6 +30,8 @@ t_conflicts/1, t_locations/1, t_swap_keys/1, + t_implicit_start/1, + t_crash_before_collect/1, smoke_lcnt/1]). init_per_testcase(_Case, Config) -> @@ -44,8 +46,8 @@ suite() -> {timetrap,{minutes,4}}]. all() -> - [t_load, t_conflicts, t_locations, t_swap_keys, - smoke_lcnt]. + [t_load, t_conflicts, t_locations, t_swap_keys, t_implicit_start, + t_crash_before_collect, smoke_lcnt]. %%---------------------------------------------------------------------- %% Tests @@ -149,6 +151,15 @@ t_swap_keys_file([File|Files]) -> ok = lcnt:stop(), t_swap_keys_file(Files). +%% Prior to OTP-14913 this would crash with 'noproc' as the lcnt server hadn't +%% been started yet. +t_implicit_start(Config) when is_list(Config) -> + ok = lcnt:conflicts(). + +t_crash_before_collect(Config) when is_list(Config) -> + {ok, _} = lcnt:start(), + ok = lcnt:information(). + %% Simple smoke test of actual lock-counting, if running on %% a run-time with lock-counting enabled. smoke_lcnt(Config) -> |