aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/test/asn1_SUITE.erl4
-rw-r--r--lib/common_test/src/ct_testspec.erl7
-rw-r--r--lib/compiler/src/beam_type.erl8
-rw-r--r--lib/compiler/src/beam_validator.erl7
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl33
-rw-r--r--lib/crypto/c_src/crypto.c26
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl26
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same.erl15
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para_bug/same_type.erl13
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/record_match3
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/bsL.erl13
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/record_match.erl17
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl3
-rw-r--r--lib/hipe/cerl/erl_types.erl4
-rw-r--r--lib/hipe/llvm/hipe_llvm.erl2
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_construct.erl13
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/c_client.c8
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c8
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c8
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl4
-rw-r--r--lib/inets/src/inets_app/inets.appup.src4
-rw-r--r--lib/inets/test/httpc_SUITE.erl42
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/kernel_app.xml20
-rw-r--r--lib/kernel/doc/src/notes.xml20
-rw-r--r--lib/kernel/doc/src/os.xml43
-rw-r--r--lib/kernel/src/code_server.erl27
-rw-r--r--lib/kernel/src/disk_log.erl4
-rw-r--r--lib/kernel/src/erl_boot_server.erl37
-rw-r--r--lib/kernel/src/group_history.erl4
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl5
-rw-r--r--lib/kernel/src/kernel.app.src2
-rw-r--r--lib/kernel/src/os.erl37
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl2
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl8
-rw-r--r--lib/kernel/test/global_SUITE.erl17
-rw-r--r--lib/kernel/test/inet_SUITE.erl8
-rw-r--r--lib/kernel/test/os_SUITE.erl18
-rw-r--r--lib/kernel/vsn.mk2
-rw-r--r--lib/observer/src/cdv_detail_wx.erl11
-rw-r--r--lib/observer/src/cdv_info_wx.erl4
-rw-r--r--lib/observer/src/cdv_port_cb.erl17
-rw-r--r--lib/observer/src/cdv_proc_cb.erl4
-rw-r--r--lib/observer/src/cdv_sched_cb.erl18
-rw-r--r--lib/observer/src/crashdump_viewer.erl322
-rw-r--r--lib/observer/src/crashdump_viewer.hrl16
-rw-r--r--lib/observer/src/observer_lib.erl67
-rw-r--r--lib/observer/src/observer_port_wx.erl4
-rw-r--r--lib/observer/src/observer_pro_wx.erl3
-rw-r--r--lib/observer/src/observer_procinfo.erl6
-rw-r--r--lib/observer/src/observer_tv_wx.erl355
-rw-r--r--lib/observer/test/crashdump_helper.erl1
-rw-r--r--lib/observer/test/observer_SUITE.erl7
-rw-r--r--lib/runtime_tools/doc/src/notes.xml17
-rw-r--r--lib/runtime_tools/src/erts_alloc_config.erl8
-rw-r--r--lib/runtime_tools/src/system_information.erl232
-rw-r--r--lib/runtime_tools/vsn.mk2
-rw-r--r--lib/snmp/doc/src/snmp_impl_example_agent.xml10
-rw-r--r--lib/ssh/doc/src/notes.xml36
-rw-r--r--lib/ssh/doc/src/ssh.xml12
-rw-r--r--lib/ssh/doc/src/ssh_sftp.xml7
-rw-r--r--lib/ssh/src/ssh_acceptor_sup.erl5
-rw-r--r--lib/ssh/src/ssh_channel_sup.erl11
-rw-r--r--lib/ssh/src/ssh_connection.erl28
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl7
-rw-r--r--lib/ssh/src/ssh_connection_sup.erl5
-rw-r--r--lib/ssh/src/ssh_options.erl6
-rw-r--r--lib/ssh/src/ssh_subsystem_sup.erl8
-rw-r--r--lib/ssh/src/ssh_sup.erl15
-rw-r--r--lib/ssh/src/ssh_system_sup.erl9
-rw-r--r--lib/ssh/src/ssh_transport.erl5
-rw-r--r--lib/ssh/src/sshc_sup.erl5
-rw-r--r--lib/ssh/src/sshd_sup.erl6
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl6
-rw-r--r--lib/ssh/test/ssh_compat_SUITE.erl1019
-rwxr-xr-xlib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh28
-rwxr-xr-xlib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-dropbear-ssh-run27
-rwxr-xr-xlib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image3
-rwxr-xr-xlib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image14
-rwxr-xr-xlib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all28
-rw-r--r--lib/ssh/test/ssh_connection_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_engine_SUITE.erl26
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl122
-rw-r--r--lib/ssh/test/ssh_sup_SUITE.erl113
-rw-r--r--lib/ssh/test/ssh_test_lib.erl10
-rw-r--r--lib/ssh/test/ssh_test_lib.hrl7
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl359
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/ssl.xml95
-rw-r--r--lib/ssl/doc/src/using_ssl.xml46
-rw-r--r--lib/ssl/src/dtls_connection.erl13
-rw-r--r--lib/ssl/src/dtls_record.erl30
-rw-r--r--lib/ssl/src/dtls_v1.erl8
-rw-r--r--lib/ssl/src/ssl.erl120
-rw-r--r--lib/ssl/src/ssl_cipher.erl288
-rw-r--r--lib/ssl/src/ssl_connection.erl4
-rw-r--r--lib/ssl/src/tls_connection.erl26
-rw-r--r--lib/ssl/src/tls_record.erl37
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl151
-rw-r--r--lib/ssl/test/ssl_test_lib.erl105
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl37
-rw-r--r--lib/stdlib/doc/src/assert_hrl.xml2
-rw-r--r--lib/stdlib/doc/src/ets.xml6
-rw-r--r--lib/stdlib/doc/src/filelib.xml4
-rw-r--r--lib/stdlib/doc/src/filename.xml19
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml54
-rw-r--r--lib/stdlib/src/epp.erl18
-rw-r--r--lib/stdlib/src/ets.erl4
-rw-r--r--lib/stdlib/src/filelib.erl21
-rw-r--r--lib/stdlib/src/gen_event.erl5
-rw-r--r--lib/stdlib/src/gen_fsm.erl4
-rw-r--r--lib/stdlib/src/gen_statem.erl1573
-rw-r--r--lib/stdlib/src/io_lib.erl4
-rw-r--r--lib/stdlib/src/io_lib_fread.erl4
-rw-r--r--lib/stdlib/src/lib.erl6
-rw-r--r--lib/stdlib/src/shell.erl6
-rw-r--r--lib/stdlib/src/sys.erl6
-rw-r--r--lib/stdlib/test/epp_SUITE.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl7
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl6
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/unicode12
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/unicode22
-rw-r--r--lib/stdlib/test/ets_SUITE.erl26
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl35
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl8
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl14
-rw-r--r--lib/stdlib/test/io_SUITE.erl6
-rw-r--r--lib/stdlib/test/re_SUITE.erl15
-rw-r--r--lib/stdlib/test/shell_SUITE.erl25
-rw-r--r--lib/tools/doc/src/lcnt.xml2
-rw-r--r--lib/tools/src/lcnt.erl9
-rw-r--r--lib/tools/test/lcnt_SUITE.erl15
132 files changed, 4158 insertions, 2276 deletions
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index b98a704e28..bfeffa969f 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -1355,8 +1355,8 @@ xref_export_all(_Config) ->
[] ->
ok;
[_|_] ->
- S = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused],
- io:format("There are unused functions:\n\n~s\n", [S]),
+ Msg = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused],
+ io:format("There are unused functions:\n\n~s\n", [Msg]),
?t:fail(unused_functions)
end.
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/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 6957d25774..9a3ea07c97 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -179,6 +179,12 @@
# define HAVE_ECB_IVEC_BUG
#endif
+#define HAVE_RSA_SSLV23_PADDING
+#if defined(HAS_LIBRESSL) \
+ && LIBRESSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(2,6,1)
+# undef HAVE_RSA_SSLV23_PADDING
+#endif
+
#if defined(HAVE_CMAC)
#include <openssl/cmac.h>
#endif
@@ -659,7 +665,9 @@ static ERL_NIF_TERM atom_rsa_oaep_md;
static ERL_NIF_TERM atom_rsa_pad; /* backwards compatibility */
static ERL_NIF_TERM atom_rsa_padding;
static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding;
+#ifdef HAVE_RSA_SSLV23_PADDING
static ERL_NIF_TERM atom_rsa_sslv23_padding;
+#endif
static ERL_NIF_TERM atom_rsa_x931_padding;
static ERL_NIF_TERM atom_rsa_pss_saltlen;
static ERL_NIF_TERM atom_sha224;
@@ -1064,7 +1072,9 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
atom_rsa_pad = enif_make_atom(env,"rsa_pad"); /* backwards compatibility */
atom_rsa_padding = enif_make_atom(env,"rsa_padding");
atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding");
+#ifdef HAVE_RSA_SSLV23_PADDING
atom_rsa_sslv23_padding = enif_make_atom(env,"rsa_sslv23_padding");
+#endif
atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding");
atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen");
atom_sha224 = enif_make_atom(env,"sha224");
@@ -4449,8 +4459,10 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI
opt->rsa_padding = RSA_PKCS1_PADDING;
} else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) {
opt->rsa_padding = RSA_PKCS1_OAEP_PADDING;
+#ifdef HAVE_RSA_SSLV23_PADDING
} else if (tpl_terms[1] == atom_rsa_sslv23_padding) {
opt->rsa_padding = RSA_SSLV23_PADDING;
+#endif
} else if (tpl_terms[1] == atom_rsa_x931_padding) {
opt->rsa_padding = RSA_X931_PADDING;
} else if (tpl_terms[1] == atom_rsa_no_padding) {
@@ -4516,7 +4528,10 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
#endif
PKeyCryptOptions crypt_opt;
ErlNifBinary in_bin, out_bin, tmp_bin;
- size_t outlen, tmplen;
+ size_t outlen;
+#ifdef HAVE_RSA_SSLV23_PADDING
+ size_t tmplen;
+#endif
int is_private = (argv[4] == atom_true),
is_encrypt = (argv[5] == atom_true);
int algo_init = 0;
@@ -4596,6 +4611,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
if (crypt_opt.signature_md != NULL
&& EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0)
goto badarg;
+#ifdef HAVE_RSA_SSLV23_PADDING
if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
if (is_encrypt) {
RSA *rsa = EVP_PKEY_get1_RSA(pkey);
@@ -4607,9 +4623,11 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
in_bin = tmp_bin;
}
if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg;
- } else {
+ } else
+#endif
+ {
if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg;
- }
+ }
#ifdef HAVE_RSA_OAEP_MD
if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) {
if (crypt_opt.rsa_oaep_md != NULL
@@ -4728,6 +4746,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
#endif
if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) {
+#ifdef HAVE_RSA_SSLV23_PADDING
if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
RSA *rsa = EVP_PKEY_get1_RSA(pkey);
unsigned char *p;
@@ -4745,6 +4764,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
i = 1;
}
}
+#endif
}
if (tmp_bin.data != NULL) {
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/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl
index b9e7d93570..aa85626857 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl
@@ -279,13 +279,22 @@ bad_floats() ->
%% (incorrectly) signed.
huge_binaries() ->
- AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>),
case erlang:system_info(wordsize) of
- 4 -> huge_binaries_32(AlmostIllegal);
+ 4 ->
+ Old = erts_debug:set_internal_state(available_internal_state, true),
+ case erts_debug:set_internal_state(binary, (1 bsl 29)-1) of
+ false ->
+ io:format("\nNot enough memory to create 512Mb binary\n",[]);
+ Bin->
+ huge_binaries_32(Bin)
+ end,
+ erts_debug:set_internal_state(available_internal_state, Old);
+
8 -> ok
end,
garbage_collect(),
id(<<0:(id((1 bsl 31)-1))>>),
+ garbage_collect(),
id(<<0:(id((1 bsl 30)-1))>>),
garbage_collect(),
ok.
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c
index b3a18e03d4..446b46ad82 100644
--- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c
+++ b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c
@@ -1365,8 +1365,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2)
return 0;
if (!cmp_str(b1->str6,b2->str6))
return 0;
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
if (b1->str7[i][j] != b2->str7[i][j])
return 0;
for (j = 0; j < 3; j++)
@@ -1579,8 +1579,8 @@ static void print_strRec(m_strRec* sr)
fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
fprintf(stdout, "string str4 : %s\n",sr->str4);
fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
for (j = 0; j < sr->str5._length; j++)
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c
index 40c7328f03..d6a78d2481 100644
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c
+++ b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c
@@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2)
return 0;
if (!cmp_str(b1->str6,b2->str6))
return 0;
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
if (b1->str7[i][j] != b2->str7[i][j])
return 0;
for (j = 0; j < 3; j++)
@@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr)
fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
fprintf(stdout, "string str4 : %s\n",sr->str4);
fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
for (j = 0; j < sr->str5._length; j++)
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c
index 33cfe71322..17ef21f4f4 100644
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c
+++ b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c
@@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2)
return 0;
if (!cmp_str(b1->str6,b2->str6))
return 0;
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
if (b1->str7[i][j] != b2->str7[i][j])
return 0;
for (j = 0; j < 3; j++)
@@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr)
fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
fprintf(stdout, "string str4 : %s\n",sr->str4);
fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
+ for (i = 0; i < 3; i++)
+ for (j = 0; j < 2; j++)
fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
for (j = 0; j < sr->str5._length; j++)
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/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index e5ac031539..0762cebc94 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1996</year><year>2017</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -469,8 +469,12 @@ MaxT = TickTime + TickTime / 4</code>
<item><c>ObjSuffix = string()</c></item>
<item><c>SrcSuffix = string()</c></item>
</list>
- <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and
- <c>filelib:find_source/2</c>. If this is set to some other value
+ <p>Specifies a list of rules for use by
+ <seealso marker="stdlib:filelib#find_file/2">
+ <c>filelib:find_file/2</c></seealso>
+ <seealso marker="stdlib:filelib#find_source/2">
+ <c>filelib:find_source/2</c></seealso>
+ If this is set to some other value
than the empty list, it replaces the default rules. Rules can be
simple pairs of directory suffixes, such as <c>{"ebin",
"src"}</c>, which are used by <c>filelib:find_file/2</c>, or
@@ -478,6 +482,16 @@ MaxT = TickTime + TickTime / 4</code>
file name extensions, for example <c>[{".beam", ".erl", [{"ebin",
"src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both
kinds of rules can be mixed in the list.</p>
+ <p>The interpretation of <c>ObjDirSuffix</c> and <c>SrcDirSuffix</c>
+ is as follows: if the end of the directory name where an
+ object is located matches <c>ObjDirSuffix</c>, then the
+ name created by replacing <c>ObjDirSuffix</c> with
+ <c>SrcDirSuffix</c> is expanded by calling
+ <seealso marker="stdlib:filelib#wildcard/1">
+ <c>filelib:wildcard/1</c></seealso>, and the first regular
+ file found among the matches is the source file.
+ </p>
+
</item>
</taglist>
</section>
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/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
index bbfaa9d147..e34b4d77d2 100644
--- a/lib/kernel/test/erl_distribution_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -95,7 +95,11 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
+init_per_testcase(TC, Config) when TC == hostnames;
+ TC == nodenames ->
+ file:make_dir("hostnames_nodedir"),
+ file:write_file("hostnames_nodedir/ignore_core_files",""),
+ Config;
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Config.
@@ -251,7 +255,7 @@ test_node(Name, Illigal) ->
end,
net_kernel:monitor_nodes(true),
BinCommand = unicode:characters_to_binary(Command, utf8),
- Prt = open_port({spawn, BinCommand}, [stream]),
+ Prt = open_port({spawn, BinCommand}, [stream,{cd,"hostnames_nodedir"}]),
Node = list_to_atom(Name),
receive
{nodeup, Node} ->
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/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index 3b502be8b8..ba0d075ef2 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -1083,11 +1083,9 @@ ifaddrs([{If,Opts}|IOs]) ->
#ifopts{flags=F} = Ifopts = check_ifopts(Opts, #ifopts{name=If}),
case F of
{flags,Flags} ->
- case lists:member(up, Flags) of
- true ->
- Ifopts#ifopts.addrs;
- false ->
- []
+ case lists:member(running, Flags) of
+ true -> Ifopts#ifopts.addrs;
+ false -> []
end ++ ifaddrs(IOs);
undefined ->
ifaddrs(IOs)
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/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl
index f6d282638a..6c4739042b 100644
--- a/lib/observer/src/cdv_detail_wx.erl
+++ b/lib/observer/src/cdv_detail_wx.erl
@@ -48,6 +48,7 @@ init([Id, Data, ParentFrame, Callback, App, Parent]) ->
display_progress(ParentFrame,App),
case Callback:get_details(Id, Data) of
{ok,Details} ->
+ display_progress_pulse(Callback,Id),
init(Id,ParentFrame,Callback,App,Parent,Details);
{yes_no, Info, Fun} ->
destroy_progress(App),
@@ -69,8 +70,16 @@ display_progress(ParentFrame,cdv) ->
"Reading data");
display_progress(_,_) ->
ok.
+
+%% Display pulse while creating process detail page with much data
+display_progress_pulse(cdv_proc_cb,Pid) ->
+ observer_lib:report_progress({ok,"Displaying data for "++Pid}),
+ observer_lib:report_progress({ok,start_pulse});
+display_progress_pulse(_,_) ->
+ ok.
+
destroy_progress(cdv) ->
- observer_lib:destroy_progress_dialog();
+ observer_lib:sync_destroy_progress_dialog();
destroy_progress(_) ->
ok.
diff --git a/lib/observer/src/cdv_info_wx.erl b/lib/observer/src/cdv_info_wx.erl
index 7e416dd11a..07c28610e2 100644
--- a/lib/observer/src/cdv_info_wx.erl
+++ b/lib/observer/src/cdv_info_wx.erl
@@ -95,6 +95,10 @@ handle_cast(Msg, State) ->
io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]),
{noreply, State}.
+handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) ->
+ observer_lib:add_scroll_entries(MoreEntry,More),
+ {noreply, State};
+
handle_event(#wx{event=#wxMouse{type=left_down},userData=Target}, State) ->
cdv_virtual_list_wx:start_detail_win(Target),
{noreply, State};
diff --git a/lib/observer/src/cdv_port_cb.erl b/lib/observer/src/cdv_port_cb.erl
index b5cbe8132d..6bb8f07a74 100644
--- a/lib/observer/src/cdv_port_cb.erl
+++ b/lib/observer/src/cdv_port_cb.erl
@@ -34,7 +34,8 @@
-define(COL_CONN, ?COL_ID+1).
-define(COL_NAME, ?COL_CONN+1).
-define(COL_CTRL, ?COL_NAME+1).
--define(COL_SLOT, ?COL_CTRL+1).
+-define(COL_QUEUE, ?COL_CTRL+1).
+-define(COL_SLOT, ?COL_QUEUE+1).
@@ -44,6 +45,7 @@ col_to_elem(?COL_ID) -> #port.id;
col_to_elem(?COL_CONN) -> #port.connected;
col_to_elem(?COL_NAME) -> #port.name;
col_to_elem(?COL_CTRL) -> #port.controls;
+col_to_elem(?COL_QUEUE) -> #port.queue;
col_to_elem(?COL_SLOT) -> #port.slot.
col_spec() ->
@@ -51,6 +53,7 @@ col_spec() ->
{"Connected", ?wxLIST_FORMAT_LEFT, 120},
{"Name", ?wxLIST_FORMAT_LEFT, 150},
{"Controls", ?wxLIST_FORMAT_LEFT, 200},
+ {"Queue", ?wxLIST_FORMAT_RIGHT, 100},
{"Slot", ?wxLIST_FORMAT_RIGHT, 50}].
get_info(_) ->
@@ -96,9 +99,17 @@ format(D) ->
info_fields() ->
[{"Overview",
[{"Name", name},
+ {"State", state},
+ {"Task Flags", task_flags},
{"Connected", {click,connected}},
{"Slot", slot},
- {"Controls", controls}]},
+ {"Controls", controls},
+ {"Input bytes", input},
+ {"Output bytes", output},
+ {"Queue bytes", queue},
+ {"Port data", port_data}]},
{scroll_boxes,
[{"Links",1,{click,links}},
- {"Monitors",1,{click,monitors}}]}].
+ {"Monitors",1,{click,monitors}},
+ {"Suspended",1,{click,suspended}}
+ ]}].
diff --git a/lib/observer/src/cdv_proc_cb.erl b/lib/observer/src/cdv_proc_cb.erl
index f10650bbb7..0ea23dd7cb 100644
--- a/lib/observer/src/cdv_proc_cb.erl
+++ b/lib/observer/src/cdv_proc_cb.erl
@@ -149,6 +149,10 @@ info_fields() ->
{"Old Heap", old_heap},
{"Heap Unused", heap_unused},
{"Old Heap Unused", old_heap_unused},
+ {"Binary vheap", bin_vheap},
+ {"Old Binary vheap", old_bin_vheap},
+ {"Binary vheap unused", bin_vheap_unused},
+ {"Old Binary vheap unused", old_bin_vheap_unused},
{"Number of Heap Fragements", num_heap_frag},
{"Heap Fragment Data",heap_frag_data},
{"New Heap Start", new_heap_start},
diff --git a/lib/observer/src/cdv_sched_cb.erl b/lib/observer/src/cdv_sched_cb.erl
index 192aaf31a7..d2696a276f 100644
--- a/lib/observer/src/cdv_sched_cb.erl
+++ b/lib/observer/src/cdv_sched_cb.erl
@@ -31,7 +31,8 @@
%% Columns
-define(COL_ID, 0).
--define(COL_PROC, ?COL_ID+1).
+-define(COL_TYPE, ?COL_ID+1).
+-define(COL_PROC, ?COL_TYPE+1).
-define(COL_PORT, ?COL_PROC+1).
-define(COL_RQL, ?COL_PORT+1).
-define(COL_PQL, ?COL_RQL+1).
@@ -39,6 +40,7 @@
%% Callbacks for cdv_virtual_list_wx
col_to_elem(id) -> col_to_elem(?COL_ID);
col_to_elem(?COL_ID) -> #sched.name;
+col_to_elem(?COL_TYPE) -> #sched.type;
col_to_elem(?COL_PROC) -> #sched.process;
col_to_elem(?COL_PORT) -> #sched.port;
col_to_elem(?COL_RQL) -> #sched.run_q;
@@ -46,6 +48,7 @@ col_to_elem(?COL_PQL) -> #sched.port_q.
col_spec() ->
[{"Id", ?wxLIST_FORMAT_RIGHT, 50},
+ {"Type", ?wxLIST_FORMAT_CENTER, 100},
{"Current Process", ?wxLIST_FORMAT_CENTER, 130},
{"Current Port", ?wxLIST_FORMAT_CENTER, 130},
{"Run Queue Length", ?wxLIST_FORMAT_RIGHT, 180},
@@ -73,7 +76,8 @@ detail_pages() ->
[{"Scheduler Information", fun init_gen_page/2}].
init_gen_page(Parent, Info0) ->
- Fields = info_fields(),
+ Type = proplists:get_value(type, Info0),
+ Fields = info_fields(Type),
Details = proplists:get_value(details, Info0),
Info = if is_map(Details) -> Info0 ++ maps:to_list(Details);
true -> Info0
@@ -81,15 +85,16 @@ init_gen_page(Parent, Info0) ->
cdv_info_wx:start_link(Parent,{Fields,Info,[]}).
%%% Internal
-info_fields() ->
+info_fields(Type) ->
[{"Scheduler Overview",
[{"Id", id},
+ {"Type", type},
{"Current Process",process},
{"Current Port", port},
{"Sleep Info Flags", sleep_info},
{"Sleep Aux Work", sleep_aux}
]},
- {"Run Queues",
+ {run_queues_header(Type),
[{"Flags", runq_flags},
{"Priority Max Length", runq_max},
{"Priority High Length", runq_high},
@@ -116,3 +121,8 @@ info_fields() ->
{" ", {currp_stack, 11}}
]}
].
+
+run_queues_header(normal) ->
+ "Run Queues";
+run_queues_header(DirtyX) ->
+ "Run Queues (common for all '" ++ atom_to_list(DirtyX) ++ "' schedulers)".
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index c100e8d057..d2a175d52d 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -116,6 +116,10 @@
-define(allocator,allocator).
-define(atoms,atoms).
-define(binary,binary).
+-define(dirty_cpu_scheduler,dirty_cpu_scheduler).
+-define(dirty_cpu_run_queue,dirty_cpu_run_queue).
+-define(dirty_io_scheduler,dirty_io_scheduler).
+-define(dirty_io_run_queue,dirty_io_run_queue).
-define(ende,ende).
-define(erl_crash_dump,erl_crash_dump).
-define(ets,ets).
@@ -1222,6 +1226,18 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) ->
"OldHeap unused" ->
Bytes = list_to_integer(bytes(Fd))*WS,
get_procinfo(Fd,Fun,Proc#proc{old_heap_unused=Bytes},WS);
+ "BinVHeap" ->
+ Bytes = list_to_integer(bytes(Fd))*WS,
+ get_procinfo(Fd,Fun,Proc#proc{bin_vheap=Bytes},WS);
+ "OldBinVHeap" ->
+ Bytes = list_to_integer(bytes(Fd))*WS,
+ get_procinfo(Fd,Fun,Proc#proc{old_bin_vheap=Bytes},WS);
+ "BinVHeap unused" ->
+ Bytes = list_to_integer(bytes(Fd))*WS,
+ get_procinfo(Fd,Fun,Proc#proc{bin_vheap_unused=Bytes},WS);
+ "OldBinVHeap unused" ->
+ Bytes = list_to_integer(bytes(Fd))*WS,
+ get_procinfo(Fd,Fun,Proc#proc{old_bin_vheap_unused=Bytes},WS);
"New heap start" ->
get_procinfo(Fd,Fun,Proc#proc{new_heap_start=bytes(Fd)},WS);
"New heap top" ->
@@ -1240,7 +1256,7 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) ->
"Last calls" ->
get_procinfo(Fd,Fun,Proc#proc{last_calls=get_last_calls(Fd)},WS);
"Link list" ->
- {Links,Monitors,MonitoredBy} = parse_link_list(bytes(Fd),[],[],[]),
+ {Links,Monitors,MonitoredBy} = get_link_list(Fd),
get_procinfo(Fd,Fun,Proc#proc{links=Links,
monitors=Monitors,
mon_by=MonitoredBy},WS);
@@ -1322,86 +1338,64 @@ get_last_calls(Fd,<<>>,Acc,Lines) ->
lists:reverse(Lines,[byte_list_to_string(lists:reverse(Acc))])
end.
-parse_link_list([SB|Str],Links,Monitors,MonitoredBy) when SB==$[; SB==$] ->
- parse_link_list(Str,Links,Monitors,MonitoredBy);
-parse_link_list("#Port"++_=Str,Links,Monitors,MonitoredBy) ->
- {Link,Rest} = parse_port(Str),
- parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy);
-parse_link_list("<"++_=Str,Links,Monitors,MonitoredBy) ->
- {Link,Rest} = parse_pid(Str),
- parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy);
-parse_link_list("{to,"++Str,Links,Monitors,MonitoredBy) ->
- {Mon,Rest} = parse_monitor(Str),
- parse_link_list(Rest,Links,[Mon|Monitors],MonitoredBy);
-parse_link_list("{from,"++Str,Links,Monitors,MonitoredBy) ->
- {Mon,Rest} = parse_monitor(Str),
- parse_link_list(Rest,Links,Monitors,[Mon|MonitoredBy]);
-parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) ->
- parse_link_list(Rest,Links,Monitors,MonitoredBy);
-parse_link_list([],Links,Monitors,MonitoredBy) ->
- {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)};
-parse_link_list(Unexpected,Links,Monitors,MonitoredBy) ->
- io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]),
- parse_link_list([],Links,Monitors,MonitoredBy).
-
-
-parse_port(Str) ->
- {Port,Rest} = parse_link(Str,[]),
- {{Port,Port},Rest}.
-
-parse_pid(Str) ->
- {Pid,Rest} = parse_link(Str,[]),
- {{Pid,Pid},Rest}.
-
-parse_monitor("{"++Str) ->
- %% Named process
- {Name,Node,Rest1} = parse_name_node(Str,[]),
- Pid = get_pid_from_name(Name,Node),
- case parse_link(string:strip(Rest1,left,$,),[]) of
- {Ref,"}"++Rest2} ->
- %% Bug in break.c - prints an extra "}" for remote
- %% nodes... thus the strip
- {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},
- string:strip(Rest2,left,$})};
- {Ref,[]} ->
- {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},[]}
- end;
-parse_monitor(Str) ->
- case parse_link(Str,[]) of
- {Pid,","++Rest1} ->
- case parse_link(Rest1,[]) of
- {Ref,"}"++Rest2} ->
- {{Pid,Pid++" ("++Ref++")"},Rest2};
- {Ref,[]} ->
- {{Pid,Pid++" ("++Ref++")"},[]}
- end;
- {Pid,[]} ->
- {{Pid,Pid++" (unknown_ref)"},[]}
+get_link_list(Fd) ->
+ case get_chunk(Fd) of
+ {ok,<<"[",Bin/binary>>} ->
+ #{links:=Links,
+ mons:=Monitors,
+ mon_by:=MonitoredBy} =
+ get_link_list(Fd,Bin,#{links=>[],mons=>[],mon_by=>[]}),
+ {lists:reverse(Links),
+ lists:reverse(Monitors),
+ lists:reverse(MonitoredBy)};
+ eof ->
+ {[],[],[]}
end.
-parse_link(">"++Rest,Acc) ->
- {lists:reverse(Acc,">"),Rest};
-parse_link([H|T],Acc) ->
- parse_link(T,[H|Acc]);
-parse_link([],Acc) ->
- %% truncated
- {lists:reverse(Acc),[]}.
+get_link_list(Fd,<<NL:8,_/binary>>=Bin,Acc) when NL=:=$\r; NL=:=$\n->
+ skip(Fd,Bin),
+ Acc;
+get_link_list(Fd,Bin,Acc) ->
+ case binary:split(Bin,[<<", ">>,<<"]">>]) of
+ [Link,Rest] ->
+ get_link_list(Fd,Rest,get_link(Link,Acc));
+ [Incomplete] ->
+ case get_chunk(Fd) of
+ {ok,More} ->
+ get_link_list(Fd,<<Incomplete/binary,More/binary>>,Acc);
+ eof ->
+ Acc
+ end
+ end.
-parse_name_node(","++Rest,Name) ->
- parse_name_node(Rest,Name,[]);
-parse_name_node([H|T],Name) ->
- parse_name_node(T,[H|Name]);
-parse_name_node([],Name) ->
- %% truncated
- {lists:reverse(Name),[],[]}.
-
-parse_name_node("}"++Rest,Name,Node) ->
- {lists:reverse(Name),lists:reverse(Node),Rest};
-parse_name_node([H|T],Name,Node) ->
- parse_name_node(T,Name,[H|Node]);
-parse_name_node([],Name,Node) ->
- %% truncated
- {lists:reverse(Name),lists:reverse(Node),[]}.
+get_link(<<"#Port",_/binary>>=PortBin,#{links:=Links}=Acc) ->
+ PortStr = binary_to_list(PortBin),
+ Acc#{links=>[{PortStr,PortStr}|Links]};
+get_link(<<"<",_/binary>>=PidBin,#{links:=Links}=Acc) ->
+ PidStr = binary_to_list(PidBin),
+ Acc#{links=>[{PidStr,PidStr}|Links]};
+get_link(<<"{to,",Bin/binary>>,#{mons:=Monitors}=Acc) ->
+ Acc#{mons=>[parse_monitor(Bin)|Monitors]};
+get_link(<<"{from,",Bin/binary>>,#{mon_by:=MonitoredBy}=Acc) ->
+ Acc#{mon_by=>[parse_monitor(Bin)|MonitoredBy]};
+get_link(Unexpected,Acc) ->
+ io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]),
+ Acc.
+
+parse_monitor(MonBin) ->
+ case binary:split(MonBin,[<<",">>,<<"{">>,<<"}">>],[global]) of
+ [PidBin,RefBin,<<>>] ->
+ PidStr = binary_to_list(PidBin),
+ RefStr = binary_to_list(RefBin),
+ {PidStr,PidStr++" ("++RefStr++")"};
+ [<<>>,NameBin,NodeBin,<<>>,RefBin,<<>>] ->
+ %% Named process
+ NameStr = binary_to_list(NameBin),
+ NodeStr = binary_to_list(NodeBin),
+ PidStr = get_pid_from_name(NameStr,NodeStr),
+ RefStr = binary_to_list(RefBin),
+ {PidStr,"{"++NameStr++","++NodeStr++"} ("++RefStr++")"}
+ end.
get_pid_from_name(Name,Node) ->
case ets:lookup(cdv_reg_proc_table,cdv_dump_node_name) of
@@ -1654,6 +1648,10 @@ port_to_tuple("#Port<"++Port) ->
get_portinfo(Fd,Port) ->
case line_head(Fd) of
+ "State" ->
+ get_portinfo(Fd,Port#port{state=bytes(Fd)});
+ "Task Flags" ->
+ get_portinfo(Fd,Port#port{task_flags=bytes(Fd)});
"Slot" ->
%% stored as integer so we can sort on it
get_portinfo(Fd,Port#port{slot=list_to_integer(bytes(Fd))});
@@ -1678,6 +1676,10 @@ get_portinfo(Fd,Port) ->
{Pid,Pid++" ("++Ref++")"}
end || Mon <- Monitors0],
get_portinfo(Fd,Port#port{monitors=Monitors});
+ "Suspended" ->
+ Pids = split_pid_list_no_space(bytes(Fd)),
+ Suspended = [{Pid,Pid} || Pid <- Pids],
+ get_portinfo(Fd,Port#port{suspended=Suspended});
"Port controls linked-in driver" ->
Str = lists:flatten(["Linked in driver: " | string(Fd)]),
get_portinfo(Fd,Port#port{controls=Str});
@@ -1693,6 +1695,15 @@ get_portinfo(Fd,Port) ->
"Port is UNIX fd not opened by emulator" ->
Str = lists:flatten(["UNIX fd not opened by emulator: "| string(Fd)]),
get_portinfo(Fd,Port#port{controls=Str});
+ "Input" ->
+ get_portinfo(Fd,Port#port{input=list_to_integer(bytes(Fd))});
+ "Output" ->
+ get_portinfo(Fd,Port#port{output=list_to_integer(bytes(Fd))});
+ "Queue" ->
+ get_portinfo(Fd,Port#port{queue=list_to_integer(bytes(Fd))});
+ "Port Data" ->
+ get_portinfo(Fd,Port#port{port_data=string(Fd)});
+
"=" ++ _next_tag ->
Port;
Other ->
@@ -2523,73 +2534,142 @@ get_indextableinfo1(Fd,IndexTable) ->
%%-----------------------------------------------------------------
%% Page with scheduler table information
schedulers(File) ->
- case lookup_index(?scheduler) of
- [] ->
- [];
- Schedulers ->
- Fd = open(File),
- R = lists:map(fun({Name,Start}) ->
- get_schedulerinfo(Fd,Name,Start)
- end,
- Schedulers),
- close(Fd),
- R
- end.
+ Fd = open(File),
-get_schedulerinfo(Fd,Name,Start) ->
+ Schds0 = case lookup_index(?scheduler) of
+ [] ->
+ [];
+ Normals ->
+ [{Normals, #sched{type=normal}}]
+ end,
+ Schds1 = case lookup_index(?dirty_cpu_scheduler) of
+ [] ->
+ Schds0;
+ DirtyCpus ->
+ [{DirtyCpus, get_dirty_runqueue(Fd, ?dirty_cpu_run_queue)}
+ | Schds0]
+ end,
+ Schds2 = case lookup_index(?dirty_io_scheduler) of
+ [] ->
+ Schds1;
+ DirtyIos ->
+ [{DirtyIos, get_dirty_runqueue(Fd, ?dirty_io_run_queue)}
+ | Schds1]
+ end,
+
+ R = schedulers1(Fd, Schds2, []),
+ close(Fd),
+ R.
+
+schedulers1(_Fd, [], Acc) ->
+ Acc;
+schedulers1(Fd, [{Scheds,Sched0} | Tail], Acc0) ->
+ Acc1 = lists:foldl(fun({Name,Start}, AccIn) ->
+ [get_schedulerinfo(Fd,Name,Start,Sched0) | AccIn]
+ end,
+ Acc0,
+ Scheds),
+ schedulers1(Fd, Tail, Acc1).
+
+get_schedulerinfo(Fd,Name,Start,Sched0) ->
pos_bof(Fd,Start),
- get_schedulerinfo1(Fd,#sched{name=Name}).
+ get_schedulerinfo1(Fd,Sched0#sched{name=list_to_integer(Name)}).
-get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) ->
+sched_type(?dirty_cpu_run_queue) -> dirty_cpu;
+sched_type(?dirty_io_run_queue) -> dirty_io.
+
+get_schedulerinfo1(Fd, Sched) ->
+ case get_schedulerinfo2(Fd, Sched) of
+ {more, Sched2} ->
+ get_schedulerinfo1(Fd, Sched2);
+ {done, Sched2} ->
+ Sched2
+ end.
+
+get_schedulerinfo2(Fd, Sched=#sched{details=Ds}) ->
case line_head(Fd) of
"Current Process" ->
- get_schedulerinfo1(Fd,Sched#sched{process=bytes(Fd, "None")});
+ {more, Sched#sched{process=bytes(Fd, "None")}};
"Current Port" ->
- get_schedulerinfo1(Fd,Sched#sched{port=bytes(Fd, "None")});
+ {more, Sched#sched{port=bytes(Fd, "None")}};
+
+ "Scheduler Sleep Info Flags" ->
+ {more, Sched#sched{details=Ds#{sleep_info=>bytes(Fd, "None")}}};
+ "Scheduler Sleep Info Aux Work" ->
+ {more, Sched#sched{details=Ds#{sleep_aux=>bytes(Fd, "None")}}};
+
+ "Current Process State" ->
+ {more, Sched#sched{details=Ds#{currp_state=>bytes(Fd)}}};
+ "Current Process Internal State" ->
+ {more, Sched#sched{details=Ds#{currp_int_state=>bytes(Fd)}}};
+ "Current Process Program counter" ->
+ {more, Sched#sched{details=Ds#{currp_prg_cnt=>string(Fd)}}};
+ "Current Process CP" ->
+ {more, Sched#sched{details=Ds#{currp_cp=>string(Fd)}}};
+ "Current Process Limited Stack Trace" ->
+ %% If there shall be last in scheduler information block
+ {done, Sched#sched{details=get_limited_stack(Fd, 0, Ds)}};
+
+ "=" ++ _next_tag ->
+ {done, Sched};
+
+ Other ->
+ case Sched#sched.type of
+ normal ->
+ get_runqueue_info2(Fd, Other, Sched);
+ _ ->
+ unexpected(Fd,Other,"dirty scheduler information"),
+ {done, Sched}
+ end
+ end.
+
+get_dirty_runqueue(Fd, Tag) ->
+ case lookup_index(Tag) of
+ [{_, Start}] ->
+ pos_bof(Fd,Start),
+ get_runqueue_info1(Fd,#sched{type=sched_type(Tag)});
+ [] ->
+ #sched{}
+ end.
+
+get_runqueue_info1(Fd, Sched) ->
+ case get_runqueue_info2(Fd, line_head(Fd), Sched) of
+ {more, Sched2} ->
+ get_runqueue_info1(Fd, Sched2);
+ {done, Sched2} ->
+ Sched2
+ end.
+
+get_runqueue_info2(Fd, LineHead, Sched=#sched{details=Ds}) ->
+ case LineHead of
"Run Queue Max Length" ->
RQMax = list_to_integer(bytes(Fd)),
RQ = RQMax + Sched#sched.run_q,
- get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}});
+ {more, Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}}};
"Run Queue High Length" ->
RQHigh = list_to_integer(bytes(Fd)),
RQ = RQHigh + Sched#sched.run_q,
- get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}});
+ {more, Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}}};
"Run Queue Normal Length" ->
RQNorm = list_to_integer(bytes(Fd)),
RQ = RQNorm + Sched#sched.run_q,
- get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}});
+ {more, Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}}};
"Run Queue Low Length" ->
RQLow = list_to_integer(bytes(Fd)),
RQ = RQLow + Sched#sched.run_q,
- get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}});
+ {more, Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}}};
"Run Queue Port Length" ->
RQ = list_to_integer(bytes(Fd)),
- get_schedulerinfo1(Fd,Sched#sched{port_q=RQ});
-
- "Scheduler Sleep Info Flags" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>bytes(Fd, "None")}});
- "Scheduler Sleep Info Aux Work" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>bytes(Fd, "None")}});
+ {more, Sched#sched{port_q=RQ}};
"Run Queue Flags" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>bytes(Fd, "None")}});
+ {more, Sched#sched{details=Ds#{runq_flags=>bytes(Fd, "None")}}};
- "Current Process State" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>bytes(Fd)}});
- "Current Process Internal State" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>bytes(Fd)}});
- "Current Process Program counter" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>string(Fd)}});
- "Current Process CP" ->
- get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>string(Fd)}});
- "Current Process Limited Stack Trace" ->
- %% If there shall be last in scheduler information block
- Sched#sched{details=get_limited_stack(Fd, 0, Ds)};
"=" ++ _next_tag ->
- Sched;
+ {done, Sched};
Other ->
unexpected(Fd,Other,"scheduler information"),
- Sched
+ {done, Sched}
end.
get_limited_stack(Fd, N, Ds) ->
@@ -3020,6 +3100,10 @@ tag_to_atom("allocated_areas") -> ?allocated_areas;
tag_to_atom("allocator") -> ?allocator;
tag_to_atom("atoms") -> ?atoms;
tag_to_atom("binary") -> ?binary;
+tag_to_atom("dirty_cpu_scheduler") -> ?dirty_cpu_scheduler;
+tag_to_atom("dirty_cpu_run_queue") -> ?dirty_cpu_run_queue;
+tag_to_atom("dirty_io_scheduler") -> ?dirty_io_scheduler;
+tag_to_atom("dirty_io_run_queue") -> ?dirty_io_run_queue;
tag_to_atom("end") -> ?ende;
tag_to_atom("erl_crash_dump") -> ?erl_crash_dump;
tag_to_atom("ets") -> ?ets;
diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl
index 6a93a089fd..252e19379d 100644
--- a/lib/observer/src/crashdump_viewer.hrl
+++ b/lib/observer/src/crashdump_viewer.hrl
@@ -80,6 +80,10 @@
old_heap,
heap_unused,
old_heap_unused,
+ bin_vheap,
+ old_bin_vheap,
+ bin_vheap_unused,
+ old_bin_vheap_unused,
new_heap_start,
new_heap_top,
stack_top,
@@ -95,19 +99,27 @@
-record(port,
{id,
+ state,
+ task_flags=0,
slot,
connected,
links,
name,
monitors,
- controls}).
+ suspended,
+ controls,
+ input,
+ output,
+ queue,
+ port_data}).
-record(sched,
{name,
+ type,
process,
port,
run_q=0,
- port_q=0,
+ port_q,
details=#{}
}).
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 94d199e688..0470e785d9 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -21,7 +21,8 @@
-export([get_wx_parent/1,
display_info_dialog/2, display_yes_no_dialog/1,
- display_progress_dialog/3, destroy_progress_dialog/0,
+ display_progress_dialog/3,
+ destroy_progress_dialog/0, sync_destroy_progress_dialog/0,
wait_for_progress/0, report_progress/1,
user_term/3, user_term_multiline/3,
interval_dialog/4, start_timer/1, start_timer/2, stop_timer/1, timer_config/1,
@@ -31,7 +32,8 @@
set_listctrl_col_size/2,
create_status_bar/1,
html_window/1, html_window/2,
- make_obsbin/2
+ make_obsbin/2,
+ add_scroll_entries/2
]).
-include_lib("wx/include/wx.hrl").
@@ -40,6 +42,8 @@
-define(SINGLE_LINE_STYLE, ?wxBORDER_NONE bor ?wxTE_READONLY bor ?wxTE_RICH2).
-define(MULTI_LINE_STYLE, ?SINGLE_LINE_STYLE bor ?wxTE_MULTILINE).
+-define(NUM_SCROLL_ITEMS,8).
+
-define(pulse_timeout,50).
get_wx_parent(Window) ->
@@ -397,17 +401,18 @@ get_box_info({Title, left, List}) -> {Title, ?wxALIGN_LEFT, List};
get_box_info({Title, right, List}) -> {Title, ?wxALIGN_RIGHT, List}.
add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) ->
- Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]),
+ NumStr = " ("++integer_to_list(length(List))++")",
+ Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title ++ NumStr}]),
Scroll = wxScrolledWindow:new(Panel),
wxScrolledWindow:enableScrolling(Scroll,true,true),
wxScrolledWindow:setScrollbars(Scroll,1,1,0,0),
ScrollSizer = wxBoxSizer:new(?wxVERTICAL),
wxScrolledWindow:setSizer(Scroll, ScrollSizer),
wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM),
- add_entries(Format, List, Scroll, ScrollSizer, Cursor),
+ Entries = add_entries(Format, List, Scroll, ScrollSizer, Cursor),
wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]),
wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]),
- {Scroll,ScrollSizer,length(List)}.
+ {Scroll,ScrollSizer,length(Entries)}.
add_entries(click, List, Scroll, ScrollSizer, Cursor) ->
Add = fun(Link) ->
@@ -415,7 +420,20 @@ add_entries(click, List, Scroll, ScrollSizer, Cursor) ->
wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM),
wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}])
end,
- [Add(Link) || Link <- List];
+ if length(List) > ?NUM_SCROLL_ITEMS ->
+ {List1,Rest} = lists:split(?NUM_SCROLL_ITEMS,List),
+ LinkEntries = [Add(Link) || Link <- List1],
+ NStr = integer_to_list(length(Rest)),
+ TC = link_entry2(Scroll,
+ {{more,{Rest,Scroll,ScrollSizer}},"more..."},
+ Cursor,
+ "Click to see " ++ NStr ++ " more entries"),
+ wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM),
+ E = wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]),
+ LinkEntries ++ [E];
+ true ->
+ [Add(Link) || Link <- List]
+ end;
add_entries(plain, List, Scroll, ScrollSizer, _) ->
Add = fun(String) ->
TC = wxStaticText:new(Scroll, ?wxID_ANY, String),
@@ -423,6 +441,23 @@ add_entries(plain, List, Scroll, ScrollSizer, _) ->
end,
[Add(String) || String <- List].
+add_scroll_entries(MoreEntry,{List, Scroll, ScrollSizer}) ->
+ wx:batch(
+ fun() ->
+ wxSizer:remove(ScrollSizer,?NUM_SCROLL_ITEMS),
+ wxStaticText:destroy(MoreEntry),
+ Cursor = wxCursor:new(?wxCURSOR_HAND),
+ Add = fun(Link) ->
+ TC = link_entry(Scroll, Link, Cursor),
+ wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM),
+ wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}])
+ end,
+ Entries = [Add(Link) || Link <- List],
+ wxCursor:destroy(Cursor),
+ wxSizer:layout(ScrollSizer),
+ wxSizer:setVirtualSizeHints(ScrollSizer,Scroll),
+ Entries
+ end).
create_box(_Panel, {scroll_boxes,[]}) ->
undefined;
@@ -449,7 +484,7 @@ create_box(Panel, {scroll_boxes,Data}) ->
{_,H} = wxWindow:getSize(Dummy),
wxTextCtrl:destroy(Dummy),
- MaxH = if MaxL > 8 -> 8*H;
+ MaxH = if MaxL > ?NUM_SCROLL_ITEMS -> ?NUM_SCROLL_ITEMS*H;
true -> MaxL*H
end,
[wxWindow:setMinSize(B,{0,MaxH}) || {B,_,_} <- Boxes],
@@ -504,20 +539,22 @@ create_box(Parent, Data) ->
link_entry(Panel, Link) ->
Cursor = wxCursor:new(?wxCURSOR_HAND),
- TC = link_entry2(Panel, to_link(Link), Cursor),
+ TC = link_entry(Panel, Link, Cursor),
wxCursor:destroy(Cursor),
TC.
link_entry(Panel, Link, Cursor) ->
- link_entry2(Panel, to_link(Link), Cursor).
+ link_entry2(Panel,to_link(Link),Cursor).
link_entry2(Panel,{Target,Str},Cursor) ->
+ link_entry2(Panel,{Target,Str},Cursor,"Click to see properties for " ++ Str).
+link_entry2(Panel,{Target,Str},Cursor,ToolTipText) ->
TC = wxStaticText:new(Panel, ?wxID_ANY, Str),
wxWindow:setForegroundColour(TC,?wxBLUE),
wxWindow:setCursor(TC, Cursor),
wxWindow:connect(TC, left_down, [{userData,Target}]),
wxWindow:connect(TC, enter_window),
wxWindow:connect(TC, leave_window),
- ToolTip = wxToolTip:new("Click to see properties for " ++ Str),
+ ToolTip = wxToolTip:new(ToolTipText),
wxWindow:setToolTip(TC, ToolTip),
TC.
@@ -708,6 +745,11 @@ wait_for_progress() ->
destroy_progress_dialog() ->
report_progress(finish).
+sync_destroy_progress_dialog() ->
+ Ref = erlang:monitor(process,?progress_handler),
+ destroy_progress_dialog(),
+ receive {'DOWN',Ref,process,_,_} -> ok end.
+
report_progress(Progress) ->
case whereis(?progress_handler) of
Pid when is_pid(Pid) ->
@@ -787,9 +829,8 @@ progress_dialog_new(Parent,Title,Str) ->
[{style,?wxDEFAULT_DIALOG_STYLE}]),
Panel = wxPanel:new(Dialog),
Sizer = wxBoxSizer:new(?wxVERTICAL),
- Message = wxStaticText:new(Panel, 1, Str),
- Gauge = wxGauge:new(Panel, 2, 100, [{size, {170, -1}},
- {style, ?wxGA_HORIZONTAL}]),
+ Message = wxStaticText:new(Panel, 1, Str,[{size,{220,-1}}]),
+ Gauge = wxGauge:new(Panel, 2, 100, [{style, ?wxGA_HORIZONTAL}]),
SizerFlags = ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT bor ?wxTOP,
wxSizer:add(Sizer, Message, [{flag,SizerFlags},{border,15}]),
wxSizer:add(Sizer, Gauge, [{flag, SizerFlags bor ?wxBOTTOM},{border,15}]),
diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl
index 5908e99e36..f7ae07fb85 100644
--- a/lib/observer/src/observer_port_wx.erl
+++ b/lib/observer/src/observer_port_wx.erl
@@ -242,6 +242,10 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL},
Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60),
{noreply, State#state{timer=Timer}};
+handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) ->
+ observer_lib:add_scroll_entries(MoreEntry,More),
+ {noreply, State};
+
handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) ->
observer ! {open_link, TargetPid},
{noreply, State};
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 fb02ae2728..5bc17e2aee 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -120,6 +120,10 @@ handle_event(#wx{id=?REFRESH}, #state{frame=Frame, pid=Pid, pages=Pages, expand_
end,
{noreply, State};
+handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) ->
+ observer_lib:add_scroll_entries(MoreEntry,More),
+ {noreply, State};
+
handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) ->
observer ! {open_link, TargetPid},
{noreply, State};
@@ -253,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/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index bb1755f530..b5e94a893a 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -83,6 +83,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) ->
link(OtherPid), % own node
link(Pid2), % external node
erlang:monitor(process,OtherPid),
+ erlang:monitor(process,init), % named process
erlang:monitor(process,Pid2),
code:load_file(?MODULE),
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 df25297eb9..3772fcd2f9 100644
--- a/lib/runtime_tools/src/system_information.erl
+++ b/lib/runtime_tools/src/system_information.erl
@@ -75,43 +75,37 @@ load_report(file, File) -> load_report(data, from_file(File));
load_report(data, Report) ->
ok = start_internal(), gen_server:call(?SERVER, {load_report, Report}, infinity).
-report() -> [
- {init_arguments, init:get_arguments()},
- {code_paths, code:get_path()},
- {code, code()},
- {system_info, erlang_system_info()},
- {erts_compile_info, erlang:system_info(compile_info)},
- {beam_dynamic_libraries, get_dynamic_libraries()},
- {environment_erts, os_getenv_erts_specific()},
- {environment, [split_env(Env) || Env <- os:getenv()]},
- {sanity_check, sanity_check()}
- ].
+report() ->
+ %% This is ugly but beats having to maintain two distinct implementations,
+ %% and we don't really care about memory use since it's internal and
+ %% undocumented.
+ {ok, Fd} = file:open([], [ram, read, write]),
+ to_fd(Fd),
+ {ok, _} = file:position(Fd, bof),
+ from_fd(Fd).
-spec to_file(FileName) -> ok | {error, Reason} when
FileName :: file:name_all(),
Reason :: file:posix() | badarg | terminated | system_limit.
to_file(File) ->
- file:write_file(File, iolist_to_binary([
- io_lib:format("{system_information_version, ~p}.~n", [
- ?REPORT_FILE_VSN
- ]),
- io_lib:format("{system_information, ~p}.~n", [
- report()
- ])
- ])).
+ case file:open(File, [raw, write, binary, delayed_write]) of
+ {ok, Fd} ->
+ try
+ to_fd(Fd)
+ after
+ file:close(Fd)
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
from_file(File) ->
- case file:consult(File) of
- {ok, Data} ->
- case get_value([system_information_version], Data) of
- ?REPORT_FILE_VSN ->
- get_value([system_information], Data);
- Vsn ->
- erlang:error({unknown_version, Vsn})
- end;
- _ ->
- erlang:error(bad_report_file)
+ {ok, Fd} = file:open(File, [raw, read]),
+ try
+ from_fd(Fd)
+ after
+ file:close(Fd)
end.
applications() -> applications([]).
@@ -457,61 +451,151 @@ split_env([$=|Vs], Key) -> {lists:reverse(Key), Vs};
split_env([I|Vs], Key) -> split_env(Vs, [I|Key]);
split_env([], KV) -> lists:reverse(KV). % should not happen.
-%% get applications
+from_fd(Fd) ->
+ try
+ [{system_information_version, "1.0"},
+ {system_information, Data}] = consult_fd(Fd),
+ Data
+ catch
+ _:_ -> erlang:error(bad_report_file)
+ end.
-code() ->
- % order is important
- get_code_from_paths(code:get_path()).
+consult_fd(Fd) ->
+ consult_fd_1(Fd, [], {ok, []}).
+consult_fd_1(Fd, Cont0, ReadResult) ->
+ Data =
+ case ReadResult of
+ {ok, Characters} -> Characters;
+ eof -> eof
+ end,
+ case erl_scan:tokens(Cont0, Data, 1) of
+ {done, {ok, Tokens, _}, Next} ->
+ {ok, Term} = erl_parse:parse_term(Tokens),
+ [Term | consult_fd_1(Fd, [], {ok, Next})];
+ {more, Cont} ->
+ consult_fd_1(Fd, Cont, file:read(Fd, 1 bsl 20));
+ {done, {eof, _}, eof} -> []
+ end.
-get_code_from_paths([]) -> [];
-get_code_from_paths([Path|Paths]) ->
- case is_application_path(Path) of
- true ->
- [{application, get_application_from_path(Path)}|get_code_from_paths(Paths)];
- false ->
- [{code, [
- {path, Path},
- {modules, get_modules_from_path(Path)}
- ]}|get_code_from_paths(Paths)]
+%%
+%% Dumps a system_information tuple to the given Fd, writing the term in chunks
+%% to avoid eating too much memory on large systems.
+%%
+
+to_fd(Fd) ->
+ EmitChunk =
+ fun(Format, Args) ->
+ ok = file:write(Fd, io_lib:format(Format, Args))
+ end,
+
+ EmitChunk("{system_information_version, ~w}.~n"
+ "{system_information,["
+ "{init_arguments,~w},"
+ "{code_paths,~w},",
+ [?REPORT_FILE_VSN,
+ init:get_arguments(),
+ code:get_path()]),
+
+ emit_code_info(EmitChunk),
+
+ EmitChunk( "," %% Note the leading comma!
+ "{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),
+ get_dynamic_libraries(),
+ os_getenv_erts_specific(),
+ [split_env(Env) || Env <- os:getenv()],
+ sanity_check()]).
+
+%% Emits all modules/applications in the *code path order*
+emit_code_info(EmitChunk) ->
+ EmitChunk("{code, [", []),
+ comma_separated_foreach(EmitChunk,
+ fun(Path) ->
+ case is_application_path(Path) of
+ true -> emit_application_info(EmitChunk, Path);
+ false -> emit_code_path_info(EmitChunk, Path)
+ end
+ end, code:get_path()),
+ EmitChunk("]}", []).
+
+emit_application_info(EmitChunk, Path) ->
+ [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")),
+ case file:consult(Appfile) of
+ {ok, [{application, App, Info}]} ->
+ RtDeps = proplists:get_value(runtime_dependencies, Info, []),
+ Description = proplists:get_value(description, Info, []),
+ Version = proplists:get_value(vsn, Info, []),
+
+ 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("]}}", [])
end.
+emit_code_path_info(EmitChunk, Path) ->
+ EmitChunk("{code, ["
+ "{path, ~w},", [Path]),
+ emit_module_info_from_path(EmitChunk, Path),
+ EmitChunk("]}", []).
+
+emit_module_info_from_path(EmitChunk, Path) ->
+ BeamFiles = filelib:wildcard(filename:join(Path, "*.beam")),
+
+ EmitChunk("{modules, [", []),
+ comma_separated_foreach(EmitChunk,
+ fun(Beam) ->
+ emit_module_info(EmitChunk, Beam)
+ end, BeamFiles),
+ EmitChunk("]}", []).
+
+emit_module_info(EmitChunk, Beam) ->
+ %% FIXME: The next three calls load *all* significant chunks onto the heap,
+ %% which may cause us to run out of memory if there's a huge module in the
+ %% code path.
+ {ok,{Mod, Md5}} = beam_lib:md5(Beam),
+
+ CompilerVersion = get_compiler_version(Beam),
+ Native = beam_is_native_compiled(Beam),
+
+ Loaded = case code:is_loaded(Mod) of
+ false -> false;
+ _ -> true
+ end,
+
+ EmitChunk("{~w,["
+ "{loaded,~w},"
+ "{native,~w},"
+ "{compiler,~w},"
+ "{md5,~w}"
+ "]}",
+ [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]).
+
+comma_separated_foreach(_EmitChunk, _Fun, []) ->
+ ok;
+comma_separated_foreach(_EmitChunk, Fun, [H]) ->
+ Fun(H);
+comma_separated_foreach(EmitChunk, Fun, [H | T]) ->
+ Fun(H),
+ EmitChunk(",", []),
+ comma_separated_foreach(EmitChunk, Fun, T).
+
is_application_path(Path) ->
case filelib:wildcard(filename:join(Path, "*.app")) of
[] -> false;
_ -> true
end.
-get_application_from_path(Path) ->
- [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")),
- case file:consult(Appfile) of
- {ok, [{application, App, Info}]} ->
- {App, [
- {description, proplists:get_value(description, Info, [])},
- {vsn, proplists:get_value(vsn, Info, [])},
- {path, Path},
- {runtime_dependencies,
- proplists:get_value(runtime_dependencies, Info, [])},
- {modules, get_modules_from_path(Path)}
- ]}
- end.
-
-get_modules_from_path(Path) ->
- [
- begin
- {ok,{Mod, Md5}} = beam_lib:md5(Beam),
- Loaded = case code:is_loaded(Mod) of
- false -> false;
- _ -> true
- end,
- {Mod, [
- {loaded, Loaded},
- {native, beam_is_native_compiled(Beam)},
- {compiler, get_compiler_version(Beam)},
- {md5, hexstring(Md5)}
- ]}
- end || Beam <- filelib:wildcard(filename:join(Path, "*.beam"))
- ].
-
hexstring(Bin) when is_binary(Bin) ->
lists:flatten([io_lib:format("~2.16.0b", [V]) || <<V>> <= Bin]).
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/snmp/doc/src/snmp_impl_example_agent.xml b/lib/snmp/doc/src/snmp_impl_example_agent.xml
index a86006a0a7..e576fa51f3 100644
--- a/lib/snmp/doc/src/snmp_impl_example_agent.xml
+++ b/lib/snmp/doc/src/snmp_impl_example_agent.xml
@@ -47,6 +47,7 @@
EX1-MIB DEFINITIONS ::= BEGIN
IMPORTS
+ experimental FROM RFC1155-SMI
RowStatus FROM STANDARD-MIB
DisplayString FROM RFC1213-MIB
OBJECT-TYPE FROM RFC-1212
@@ -81,7 +82,7 @@ EX1-MIB DEFINITIONS ::= BEGIN
FriendsEntry ::=
SEQUENCE {
- fIndex
+ fIndex
INTEGER,
fName
DisplayString,
@@ -105,6 +106,7 @@ EX1-MIB DEFINITIONS ::= BEGIN
DESCRIPTION
"Name of friend"
::= { friendsEntry 2 }
+
fAddress OBJECT-TYPE
SYNTAX DisplayString (SIZE (0..255))
ACCESS read-write
@@ -112,6 +114,7 @@ EX1-MIB DEFINITIONS ::= BEGIN
DESCRIPTION
"Address of friend"
::= { friendsEntry 3 }
+
fStatus OBJECT-TYPE
SYNTAX RowStatus
ACCESS read-write
@@ -119,12 +122,13 @@ EX1-MIB DEFINITIONS ::= BEGIN
DESCRIPTION
"The status of this conceptual row."
::= { friendsEntry 4 }
+
fTrap TRAP-TYPE
ENTERPRISE example1
VARIABLES { myName, fIndex }
DESCRIPTION
- "This trap is sent when something happens to
- the friend specified by fIndex."
+ "This trap is sent when something happens to
+ the friend specified by fIndex."
::= 1
END
</code>
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/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml
index ed7fbf9cf3..129426a6d5 100644
--- a/lib/ssh/doc/src/ssh_sftp.xml
+++ b/lib/ssh/doc/src/ssh_sftp.xml
@@ -464,11 +464,16 @@
<v>FileInfo = record()</v>
</type>
<desc>
- <p>Returns a <c><![CDATA[file_info]]></c> record from the file specified by
+ <p>Returns a <c><![CDATA[file_info]]></c> record from the file system object specified by
<c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. See
<seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso>
for information about the record.
</p>
+ <p>
+ Depending on the underlying OS:es links might be followed and info on the final file, directory
+ etc is returned. See <seealso marker="#read_link_info-2">ssh_sftp::read_link_info/2</seealso>
+ on how to get information on links instead.
+ </p>
</desc>
</func>
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_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 202b0afe57..d16b169da3 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -764,11 +764,11 @@ cli(Config) when is_list(Config) ->
{ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
ssh_connection:shell(ConnectionRef, ChannelId),
- ok = ssh_connection:send(ConnectionRef, ChannelId, <<"q">>),
+ ssh_connection:send(ConnectionRef, ChannelId, <<"q">>),
receive
{ssh_cm, ConnectionRef,
{data,0,0, <<"\r\nYou are accessing a dummy, type \"q\" to exit\r\n\n">>}} ->
- ok = ssh_connection:send(ConnectionRef, ChannelId, <<"q">>)
+ ssh_connection:send(ConnectionRef, ChannelId, <<"q">>)
after
30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
end,
@@ -1491,7 +1491,7 @@ new_do_shell(IO, N, Ops=[{Order,Arg}|More]) ->
ct:fail("*** Expected ~p, but got ~p",[string:strip(ExpStr),RecStr])
end
after 30000 ->
- ct:log("Meassage queue of ~p:~n~p",
+ ct:log("Message queue of ~p:~n~p",
[self(), erlang:process_info(self(), messages)]),
case Order of
expect -> ct:fail("timeout, expected ~p",[string:strip(Arg)]);
diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl
index 74ab5aca3a..f7eda1dc08 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:
@@ -94,28 +92,60 @@ end_per_suite(Config) ->
%%% os:cmd("docker rm $(docker ps -aq -f status=exited)"),
%% Remove dangling images:
%%% os:cmd("docker rmi $(docker images -f dangling=true -q)"),
+ catch ssh:stop(),
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 +168,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 +470,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 +497,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 +536,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 +547,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 +612,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 +644,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 +669,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 +701,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 +718,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 +763,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 +785,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 +838,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 +874,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 +929,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 +959,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 +976,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 +989,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 +1018,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 +1074,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_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl
index ba4518cfe6..77c299b3ee 100644
--- a/lib/ssh/test/ssh_connection_SUITE.erl
+++ b/lib/ssh/test/ssh_connection_SUITE.erl
@@ -85,6 +85,7 @@ init_per_suite(Config) ->
?CHECK_CRYPTO(Config).
end_per_suite(Config) ->
+ catch ssh:stop(),
Config.
%%--------------------------------------------------------------------
@@ -800,6 +801,8 @@ stop_listener(Config) when is_list(Config) ->
ssh:stop_daemon(Pid0),
ssh:stop_daemon(Pid1);
Error ->
+ ssh:close(ConnectionRef0),
+ ssh:stop_daemon(Pid0),
ct:fail({unexpected, Error})
end.
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..12a85c40aa 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}
].
@@ -206,32 +208,23 @@ end_per_group(_, Config) ->
%%--------------------------------------------------------------------
init_per_testcase(_TestCase, Config) ->
ssh:start(),
- Config.
-
-end_per_testcase(TestCase, Config) when TestCase == server_password_option;
- TestCase == server_userpassword_option;
- TestCase == server_pwdfun_option;
- TestCase == server_pwdfun_4_option ->
+ %% Create a clean user_dir
UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey),
ssh_test_lib:del_dirs(UserDir),
- end_per_testcase(Config);
-end_per_testcase(_TestCase, Config) ->
- end_per_testcase(Config).
+ file:make_dir(UserDir),
+ [{user_dir,UserDir}|Config].
-end_per_testcase(_Config) ->
+end_per_testcase(_TestCase, Config) ->
ssh:stop(),
ok.
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
-%%--------------------------------------------------------------------
%%% validate to server that uses the 'password' option
server_password_option(Config) when is_list(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, UserDir},
@@ -262,12 +255,10 @@ server_password_option(Config) when is_list(Config) ->
%%% validate to server that uses the 'password' option
server_userpassword_option(Config) when is_list(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, PrivDir},
+ {user_dir, UserDir},
{user_passwords, [{"vego", "morot"}]}]),
ConnectionRef =
@@ -297,15 +288,13 @@ server_userpassword_option(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
%%% validate to server that uses the 'pwdfun' option
server_pwdfun_option(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
CHKPWD = fun("foo",Pwd) -> Pwd=="bar";
(_,_) -> false
end,
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, PrivDir},
+ {user_dir, UserDir},
{pwdfun,CHKPWD}]),
ConnectionRef =
ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
@@ -335,9 +324,7 @@ server_pwdfun_option(Config) ->
%%--------------------------------------------------------------------
%%% validate to server that uses the 'pwdfun/4' option
server_pwdfun_4_option(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
PWDFUN = fun("foo",Pwd,{_,_},undefined) -> Pwd=="bar";
("fie",Pwd,{_,_},undefined) -> {Pwd=="bar",new_state};
@@ -345,7 +332,7 @@ server_pwdfun_4_option(Config) ->
(_,_,_,_) -> false
end,
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, PrivDir},
+ {user_dir, UserDir},
{pwdfun,PWDFUN}]),
ConnectionRef1 =
ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
@@ -395,9 +382,7 @@ server_pwdfun_4_option(Config) ->
%%--------------------------------------------------------------------
server_pwdfun_4_option_repeat(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
%% Test that the state works
Parent = self(),
@@ -406,7 +391,7 @@ server_pwdfun_4_option_repeat(Config) ->
(_,P,_,S) -> Parent!{P,S}, {false,S+1}
end,
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, PrivDir},
+ {user_dir, UserDir},
{auth_methods,"keyboard-interactive"},
{pwdfun,PWDFUN}]),
@@ -490,9 +475,7 @@ user_dir_option(Config) ->
%%--------------------------------------------------------------------
%%% validate client that uses the 'ssh_msg_debug_fun' option
ssh_msg_debug_fun_option_client(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
@@ -530,9 +513,7 @@ ssh_msg_debug_fun_option_client(Config) ->
%%--------------------------------------------------------------------
connectfun_disconnectfun_server(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -576,9 +557,7 @@ connectfun_disconnectfun_server(Config) ->
%%--------------------------------------------------------------------
connectfun_disconnectfun_client(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -607,9 +586,7 @@ connectfun_disconnectfun_client(Config) ->
%%--------------------------------------------------------------------
%%% validate client that uses the 'ssh_msg_debug_fun' option
ssh_msg_debug_fun_option_server(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -651,9 +628,7 @@ ssh_msg_debug_fun_option_server(Config) ->
%%--------------------------------------------------------------------
disconnectfun_option_server(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -686,9 +661,7 @@ disconnectfun_option_server(Config) ->
%%--------------------------------------------------------------------
disconnectfun_option_client(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -720,9 +693,7 @@ disconnectfun_option_client(Config) ->
%%--------------------------------------------------------------------
unexpectedfun_option_server(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -763,9 +734,7 @@ unexpectedfun_option_server(Config) ->
%%--------------------------------------------------------------------
unexpectedfun_option_client(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),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
Parent = self(),
@@ -840,14 +809,9 @@ supported_hash(HashAlg) ->
really_do_hostkey_fingerprint_check(Config, HashAlg) ->
- PrivDir = proplists:get_value(priv_dir, Config),
- UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
- file:make_dir(UserDirServer),
+ UserDir = proplists:get_value(user_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
- UserDirClient =
- ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs
-
%% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint
%% function since that function is used by the ssh client...
FPs0 = [case HashAlg of
@@ -873,7 +837,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
%% Start daemon with the public keys that we got fingerprints from
{Pid, Host0, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, UserDirServer},
+ {user_dir, UserDir},
{password, "morot"}]),
Host = ssh_test_lib:ntoa(Host0),
FP_check_fun = fun(PeerName, FP) ->
@@ -896,7 +860,8 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
end},
{user, "foo"},
{password, "morot"},
- {user_dir, UserDirClient},
+ {user_dir, UserDir},
+ {save_accepted_host, false}, % Ensure no 'known_hosts' disturbs
{user_interaction, false}]),
ssh:stop_daemon(Pid).
@@ -987,9 +952,7 @@ ms_passed(T0) ->
%%--------------------------------------------------------------------
ssh_daemon_minimal_remote_max_packet_size_option(Config) ->
SystemDir = proplists:get_value(data_dir, 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),
+ UserDir = proplists:get_value(user_dir, Config),
{Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
{user_dir, UserDir},
@@ -1314,6 +1277,33 @@ try_to_connect(Connect, Host, Port, Pid, Tref, N) ->
end.
%%--------------------------------------------------------------------
+save_accepted_host_option(Config) ->
+ UserDir = proplists:get_value(user_dir, Config),
+ KnownHosts = filename:join(UserDir, "known_hosts"),
+ 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..1df55834b1 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() ->
[].
@@ -199,7 +201,7 @@ killed_acceptor_restarts(Config) ->
Port2 = ssh_test_lib:daemon_port(DaemonPid2),
true = (Port /= Port2),
- ct:pal("~s",[lists:flatten(ssh_info:string())]),
+ ct:log("~s",[lists:flatten(ssh_info:string())]),
{ok,[{AccPid,ListenAddr,Port}]} = acceptor_pid(DaemonPid),
{ok,[{AccPid2,ListenAddr,Port2}]} = acceptor_pid(DaemonPid2),
@@ -216,11 +218,14 @@ killed_acceptor_restarts(Config) ->
%% Make acceptor restart:
exit(AccPid, kill),
+ ?wait_match(undefined, process_info(AccPid)),
%% Check it is a new acceptor:
- {ok,[{AccPid1,ListenAddr,Port}]} = acceptor_pid(DaemonPid),
- true = (AccPid /= AccPid1),
- true = (AccPid2 /= AccPid1),
+ ?wait_match({ok,[{AccPid1,ListenAddr,Port}]}, AccPid1=/=AccPid,
+ acceptor_pid(DaemonPid),
+ AccPid1,
+ 500, 30),
+ AccPid1 =/= AccPid2,
%% Connect second client and check it is alive:
{ok,C2} = ssh:connect("localhost", Port, [{silently_accept_hosts, true},
@@ -230,21 +235,113 @@ killed_acceptor_restarts(Config) ->
{user_dir, UserDir}]),
[{client_version,_}] = ssh:connection_info(C2,[client_version]),
- ct:pal("~s",[lists:flatten(ssh_info:string())]),
+ ct:log("~s",[lists:flatten(ssh_info:string())]),
%% Check first client is still alive:
[{client_version,_}] = ssh:connection_info(C1,[client_version]),
ok = ssh:stop_daemon(DaemonPid2),
- timer:sleep(15000),
+ ?wait_match(undefined, process_info(DaemonPid2), 1000, 30),
[{client_version,_}] = ssh:connection_info(C1,[client_version]),
[{client_version,_}] = ssh:connection_info(C2,[client_version]),
ok = ssh:stop_daemon(DaemonPid),
- timer:sleep(15000),
+ ?wait_match(undefined, process_info(DaemonPid), 1000, 30),
{error,closed} = ssh:connection_info(C1,[client_version]),
{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:log("~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:log("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:log("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
%%-------------------------------------------------------------------------
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_test_lib.hrl b/lib/ssh/test/ssh_test_lib.hrl
index eaf856e6e8..4b6579bd71 100644
--- a/lib/ssh/test/ssh_test_lib.hrl
+++ b/lib/ssh/test/ssh_test_lib.hrl
@@ -16,12 +16,12 @@
%%-------------------------------------------------------------------------
%% Help macro
%%-------------------------------------------------------------------------
--define(wait_match(Pattern, FunctionCall, Bind, Timeout, Ntries),
+-define(wait_match(Pattern, Guard, FunctionCall, Bind, Timeout, Ntries),
Bind =
(fun() ->
F = fun(N, F1) ->
case FunctionCall of
- Pattern -> Bind;
+ Pattern when Guard -> Bind;
_ when N>0 ->
ct:pal("Must sleep ~p ms at ~p:~p",[Timeout,?MODULE,?LINE]),
timer:sleep(Timeout),
@@ -34,6 +34,9 @@
end)()
).
+-define(wait_match(Pattern, FunctionCall, Bind, Timeout, Ntries),
+ ?wait_match(Pattern, true, FunctionCall, Bind, Timeout, Ntries)).
+
-define(wait_match(Pattern, FunctionCall, Timeout, Ntries), ?wait_match(Pattern, FunctionCall, ok, Timeout, Ntries)).
-define(wait_match(Pattern, FunctionCall, Bind), ?wait_match(Pattern, FunctionCall, Bind, 500, 10) ).
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 9258fa011b..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,
@@ -280,8 +281,11 @@ end_per_suite(_Config) ->
init_per_group(GroupName, Config) when GroupName == basic_tls;
GroupName == options_tls;
+ GroupName == options;
GroupName == basic;
- GroupName == options ->
+ GroupName == session;
+ GroupName == error_handling_tests_tls
+ ->
ssl_test_lib:clean_tls_version(Config);
init_per_group(GroupName, Config) ->
case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of
@@ -699,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),
@@ -1125,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() ->
@@ -1280,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),
@@ -3765,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, []}).
%%--------------------------------------------------------------------
@@ -3779,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, []}).
@@ -3791,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"}].
@@ -3803,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, []}).
@@ -3812,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, []}).
@@ -4589,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/filelib.xml b/lib/stdlib/doc/src/filelib.xml
index 80c4acffdb..11762a3c5a 100644
--- a/lib/stdlib/doc/src/filelib.xml
+++ b/lib/stdlib/doc/src/filelib.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2003</year><year>2017</year>
+ <year>2003</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -267,7 +267,7 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code>
for a file with the extension <c>.beam</c>, the default rule is to
look for a file with a corresponding extension <c>.erl</c> by
replacing the suffix <c>"ebin"</c> of the object directory path with
- <c>"src"</c>.
+ <c>"src"</c> or <c>"src/*"</c>.
The file search is done through <seealso
marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of
the object file is always tried before any other directory specified
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index 14fd5ef787..1135a6dd80 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1997</year><year>2017</year>
+ <year>1997</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -372,15 +372,18 @@ true
tuples <c>{<anno>BinSuffix</anno>, <anno>SourceSuffix</anno>}</c> and
is interpreted as follows: if the end of the directory name where the
object is located matches <c><anno>BinSuffix</anno></c>, then the
- source code directory has the same name, but with
- <c><anno>BinSuffix</anno></c> replaced by
- <c><anno>SourceSuffix</anno></c>. <c><anno>Rules</anno></c> defaults
+ name created by replacing <c><anno>BinSuffix</anno></c> with
+ <c><anno>SourceSuffix</anno></c> is expanded by calling
+ <seealso marker="filelib#wildcard/1">
+ <c>filelib:wildcard/1</c></seealso>.
+ If a regular file is found among the matches, the function
+ returns that location together with <c><anno>Options</anno></c>.
+ Otherwise the next rule is tried, and so on.</p>
+ <p><c><anno>Rules</anno></c> defaults
to:</p>
<code type="none">
-[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}]</code>
- <p>If the source file is found in the resulting directory, the function
- returns that location together with <c><anno>Options</anno></c>.
- Otherwise the next rule is tried, and so on.</p>
+[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"},
+ {"ebin", "src/*"}, {"ebin", "esrc/*"}]</code>
<p>The function returns <c>{<anno>SourceFile</anno>,
<anno>Options</anno>}</c> if it succeeds.
<c><anno>SourceFile</anno></c> is the absolute path to the source
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/filelib.erl b/lib/stdlib/src/filelib.erl
index d7c313f214..a9c055f72d 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.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.
@@ -544,17 +544,16 @@ default_search_rules() ->
{"", ".c", c_source_search_rules()},
{"", ".in", basic_source_search_rules()},
%% plain old directory rules, backwards compatible
- {"", ""},
- {"ebin","src"},
- {"ebin","esrc"}
- ].
+ {"", ""}] ++ erl_source_search_rules().
basic_source_search_rules() ->
(erl_source_search_rules()
++ c_source_search_rules()).
erl_source_search_rules() ->
- [{"ebin","src"}, {"ebin","esrc"}].
+ [{"ebin","src"}, {"ebin","esrc"},
+ {"ebin",filename:join("src", "*")},
+ {"ebin",filename:join("esrc", "*")}].
c_source_search_rules() ->
[{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}].
@@ -634,8 +633,16 @@ try_dir_rule(Dir, Filename, From, To) ->
Src = filename:join(NewDir, Filename),
case is_regular(Src) of
true -> {ok, Src};
- false -> error
+ false -> find_regular_file(wildcard(Src))
end;
false ->
error
end.
+
+find_regular_file([]) ->
+ error;
+find_regular_file([File|Files]) ->
+ case is_regular(File) of
+ true -> {ok, File};
+ false -> find_regular_file(Files)
+ end.
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/lib.erl b/lib/stdlib/src/lib.erl
index c6eb0d7915..be11e86100 100644
--- a/lib/stdlib/src/lib.erl
+++ b/lib/stdlib/src/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.
@@ -551,7 +551,7 @@ format_stacktrace1(S0, Stack0, PF, SF, Enc) ->
format_stacktrace2(S, Stack, 1, PF, Enc).
format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) ->
- [io_lib:fwrite(<<"~s~s ~ts ~s">>,
+ [io_lib:fwrite(<<"~s~s ~ts ~ts">>,
[sep(N, S), origin(N, M, F, A),
mfa_to_string(M, F, A, Enc),
location(L)])
@@ -573,7 +573,7 @@ location(L) ->
Line = proplists:get_value(line, L),
if
File =/= undefined, Line =/= undefined ->
- io_lib:format("(~s, line ~w)", [File, Line]);
+ io_lib:format("(~ts, line ~w)", [File, Line]);
true ->
""
end.
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 212b143b1d..ad4984b64c 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.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.
@@ -701,7 +701,9 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) ->
{W,V0};
true -> case result_will_be_saved() of
true -> V0;
- false -> ignored
+ false ->
+ erlang:garbage_collect(),
+ ignored
end
end,
{{value,V,Bs,get()},Bs};
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/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index c94821bc75..afaf2404fa 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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.
@@ -26,7 +26,7 @@
wildcard_one/1,wildcard_two/1,wildcard_errors/1,
fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1,
wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1,
- find_source/1]).
+ find_source/1, find_source_subdir/1]).
-import(lists, [foreach/2]).
@@ -47,7 +47,7 @@ all() ->
[wildcard_one, wildcard_two, wildcard_errors,
fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink,
wildcard_symlink, is_file_symlink, file_props_symlink,
- find_source].
+ find_source, find_source_subdir].
groups() ->
[].
@@ -536,16 +536,18 @@ find_source(Config) when is_list(Config) ->
[{".erl",".yrl",[{"",""}]}]),
{ok, ParserErl} = filelib:find_source(code:which(core_parse)),
+ ParserErlName = filename:basename(ParserErl),
+ ParserErlDir = filename:dirname(ParserErl),
{ok, ParserYrl} = filelib:find_source(ParserErl),
"lry." ++ _ = lists:reverse(ParserYrl),
- {ok, ParserYrl} = filelib:find_source(ParserErl,
+ {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir,
[{".beam",".erl",[{"ebin","src"}]},
{".erl",".yrl",[{"",""}]}]),
%% find_source automatically checks the local directory regardless of rules
{ok, ParserYrl} = filelib:find_source(ParserErl),
- {ok, ParserYrl} = filelib:find_source(ParserErl,
- [{".beam",".erl",[{"ebin","src"}]}]),
+ {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir,
+ [{".erl",".yrl",[{"ebin","src"}]}]),
%% find_file does not check the local directory unless in the rules
ParserYrlName = filename:basename(ParserYrl),
@@ -559,3 +561,24 @@ find_source(Config) when is_list(Config) ->
{ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir),
{ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []),
ok.
+
+find_source_subdir(Config) when is_list(Config) ->
+ BeamFile = code:which(inets), % Located in lib/inets/src/inets_app/
+ BeamName = filename:basename(BeamFile),
+ BeamDir = filename:dirname(BeamFile),
+ SrcName = filename:basename(BeamFile, ".beam") ++ ".erl",
+
+ {ok, SrcFile} = filelib:find_source(BeamName, BeamDir),
+ SrcName = filename:basename(SrcFile),
+
+ {error, not_found} =
+ filelib:find_source(BeamName, BeamDir,
+ [{".beam",".erl",[{"ebin","src"}]}]),
+ {ok, SrcFile} =
+ filelib:find_source(BeamName, BeamDir,
+ [{".beam",".erl",
+ [{"ebin",filename:join("src", "*")}]}]),
+
+ {ok, SrcFile} = filelib:find_file(SrcName, BeamDir),
+
+ ok.
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/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl
index 71f86e32e5..7b82647416 100644
--- a/lib/stdlib/test/re_SUITE.erl
+++ b/lib/stdlib/test/re_SUITE.erl
@@ -894,10 +894,13 @@ match_limit(Config) when is_list(Config) ->
%% Test that we get sub-binaries if subject is a binary and we capture
%% binaries.
sub_binaries(Config) when is_list(Config) ->
- Bin = list_to_binary(lists:seq(1,255)),
- {match,[B,C]}=re:run(Bin,"(a)",[{capture,all,binary}]),
- 255 = binary:referenced_byte_size(B),
- 255 = binary:referenced_byte_size(C),
- {match,[D]}=re:run(Bin,"(a)",[{capture,[1],binary}]),
- 255 = binary:referenced_byte_size(D),
+ %% The GC can auto-convert tiny sub-binaries to heap binaries, so we
+ %% extract large sequences to make the test more stable.
+ Bin = << <<I>> || I <- lists:seq(1, 4096) >>,
+ {match,[B,C]}=re:run(Bin,"a(.+)$",[{capture,all,binary}]),
+ true = byte_size(B) =/= byte_size(C),
+ 4096 = binary:referenced_byte_size(B),
+ 4096 = binary:referenced_byte_size(C),
+ {match,[D]}=re:run(Bin,"a(.+)$",[{capture,[1],binary}]),
+ 4096 = binary:referenced_byte_size(D),
ok.
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) ->