aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/doc/src/erl_dist_protocol.xml28
-rw-r--r--erts/doc/src/erl_ext_fig.gifbin3834 -> 3840 bytes
-rw-r--r--erts/doc/src/notes.xml22
-rw-r--r--erts/doc/src/tty.xml4
-rw-r--r--erts/emulator/beam/beam_emu.c15
-rw-r--r--erts/emulator/beam/beam_load.c19
-rw-r--r--erts/emulator/beam/bs_instrs.tab11
-rw-r--r--erts/emulator/beam/erl_posix_str.c3
-rw-r--r--erts/emulator/beam/erl_utils.h1
-rw-r--r--erts/emulator/beam/msg_instrs.tab1
-rw-r--r--erts/emulator/beam/ops.tab1
-rw-r--r--erts/emulator/beam/utils.c8
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl21
-rw-r--r--erts/emulator/test/efile_SUITE.erl45
-rw-r--r--erts/emulator/test/map_SUITE.erl92
-rw-r--r--erts/emulator/test/process_SUITE.erl42
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c4
-rw-r--r--lib/erl_interface/src/epmd/ei_epmd.h5
-rw-r--r--lib/erl_interface/src/epmd/epmd_publish.c28
-rw-r--r--lib/erl_interface/src/prog/erl_call.c3
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java6
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java6
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java7
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java50
-rw-r--r--lib/kernel/doc/src/notes.xml15
-rw-r--r--lib/kernel/src/kernel.appup.src8
-rw-r--r--lib/kernel/src/raw_file_io_inflate.erl2
-rw-r--r--lib/kernel/test/file_SUITE.erl34
-rw-r--r--lib/kernel/test/file_name_SUITE.erl11
-rw-r--r--lib/kernel/vsn.mk2
-rw-r--r--lib/ssl/src/dtls_connection.erl10
-rw-r--r--lib/ssl/src/dtls_packet_demux.erl4
-rw-r--r--lib/ssl/src/inet_tls_dist.erl10
-rw-r--r--lib/ssl/src/ssl.erl4
-rw-r--r--lib/ssl/src/ssl_cipher.erl86
-rw-r--r--lib/ssl/src/ssl_cipher.hrl80
-rw-r--r--lib/ssl/src/ssl_cipher_format.erl187
-rw-r--r--lib/ssl/src/ssl_handshake.erl2
-rw-r--r--lib/ssl/src/ssl_record.erl23
-rw-r--r--lib/ssl/src/ssl_record.hrl5
-rw-r--r--lib/ssl/src/tls_connection.erl4
-rw-r--r--lib/ssl/src/tls_record_1_3.erl2
-rw-r--r--lib/ssl/test/Makefile5
-rw-r--r--lib/ssl/test/inet_crypto_dist.erl1323
-rw-r--r--lib/ssl/test/ssl.spec2
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl363
-rw-r--r--lib/ssl/test/ssl_cipher_suite_SUITE.erl169
-rw-r--r--lib/ssl/test/ssl_dist_bench_SUITE.erl134
-rw-r--r--lib/ssl/test/ssl_test_lib.erl11
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl98
-rw-r--r--lib/ssl/test/ssl_upgrade_SUITE.erl13
-rw-r--r--lib/stdlib/doc/src/notes.xml15
-rw-r--r--lib/stdlib/src/erl_tar.erl4
-rw-r--r--lib/stdlib/src/stdlib.appup.src8
-rw-r--r--lib/stdlib/vsn.mk2
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl12
-rw-r--r--lib/tools/emacs/erlang-test.el11
-rw-r--r--lib/tools/emacs/erlang.el560
-rw-r--r--lib/tools/test/emacs_SUITE.erl23
-rw-r--r--otp_versions.table1
61 files changed, 2666 insertions, 1001 deletions
diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml
index 185c75fe84..1951d498cd 100644
--- a/erts/doc/src/erl_dist_protocol.xml
+++ b/erts/doc/src/erl_dist_protocol.xml
@@ -109,7 +109,8 @@
<title>Register a Node in EPMD</title>
<p>When a distributed node is started it registers itself in the EPMD.
The message <c>ALIVE2_REQ</c> described below is sent from the node to
- the EPMD. The response from the EPMD is <c>ALIVE2_RESP</c>.</p>
+ the EPMD. The response from the EPMD is <c>ALIVE2_X_RESP</c> (or
+ <c>ALIVE2_RESP</c>).</p>
<table align="left">
<row>
@@ -155,12 +156,12 @@
<tag><c>HighestVersion</c></tag>
<item>
<p>The highest distribution version that this node can handle.
- The value in Erlang/OTP R6B and later is 5.</p>
+ The value in OTP 22 and later is 6.</p>
</item>
<tag><c>LowestVersion</c></tag>
<item>
<p>The lowest distribution version that this node can handle.
- The value in Erlang/OTP R6B and later is 5.</p>
+ The value in OTP 22 and later is 5.</p>
</item>
<tag><c>Nlen</c></tag>
<item>
@@ -184,7 +185,24 @@
node is a distributed node. When the connection is closed,
the node is automatically unregistered from the EPMD.</p>
- <p>The response message <c>ALIVE2_RESP</c> is as follows:</p>
+ <p>The response message is either <c>ALIVE2_X_RESP</c> or
+ <c>ALIVE2_RESP</c> depending on distribution version. If both the node
+ and EPMD support distribution version 6 then response is
+ <c>ALIVE2_X_RESP</c> otherwise it is the older <c>ALIVE2_RESP</c>:</p>
+
+ <table align="left">
+ <row>
+ <cell align="center">1</cell>
+ <cell align="center">1</cell>
+ <cell align="center">4</cell>
+ </row>
+ <row>
+ <cell align="center"><c>118</c></cell>
+ <cell align="center"><c>Result</c></cell>
+ <cell align="center"><c>Creation</c></cell>
+ </row>
+ <tcaption>ALIVE2_X_RESP (118) with 32 bit creation</tcaption>
+ </table>
<table align="left">
<row>
@@ -197,7 +215,7 @@
<cell align="center"><c>Result</c></cell>
<cell align="center"><c>Creation</c></cell>
</row>
- <tcaption>ALIVE2_RESP (121)</tcaption>
+ <tcaption>ALIVE2_RESP (121) with 16-bit creation</tcaption>
</table>
<p>Result = 0 -> ok, result &gt; 0 -> error.</p>
diff --git a/erts/doc/src/erl_ext_fig.gif b/erts/doc/src/erl_ext_fig.gif
index 14d6bbc871..40dd17bd5e 100644
--- a/erts/doc/src/erl_ext_fig.gif
+++ b/erts/doc/src/erl_ext_fig.gif
Binary files differ
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 248b871ca0..7c5a8aefad 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -31,6 +31,28 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 10.3.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed a bug in <c>seq_trace:reset_trace/0</c> that
+ could crash the emulator.</p>
+ <p>
+ Own Id: OTP-15704</p>
+ </item>
+ <item>
+ <p>
+ Fixed bug in <c>process_info(reductions)</c> causing it
+ to sometimes return invalid results.</p>
+ <p>
+ Own Id: OTP-15709 Aux Id: ERIERL-337 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 10.3.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/doc/src/tty.xml b/erts/doc/src/tty.xml
index 51db1ba8e2..c33e082f4f 100644
--- a/erts/doc/src/tty.xml
+++ b/erts/doc/src/tty.xml
@@ -165,6 +165,10 @@ erl</pre>
<cell align="left" valign="middle">C-y</cell>
<cell align="left" valign="middle">Insert previously killed text</cell>
</row>
+ <row>
+ <cell align="left" valign="middle">C-]</cell>
+ <cell align="left" valign="middle">Insert matching closing bracket</cell>
+ </row>
<tcaption>tty Text Editing</tcaption>
</table>
</section>
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index f1d8609066..ea01ce597d 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -3267,20 +3267,23 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity)
/*
- * Return the current number of reductions for the given process.
+ * Return the current number of reductions consumed by the given process.
* To get the total number of reductions, p->reds must be added.
*/
Uint
-erts_current_reductions(Process *current, Process *p)
+erts_current_reductions(Process *c_p, Process *p)
{
- if (current != p) {
+ Sint reds_left;
+ if (c_p != p || !(erts_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_RUNNING)) {
return 0;
- } else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) {
- return current->fcalls + CONTEXT_REDS;
+ } else if (c_p->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
+ reds_left = c_p->fcalls + CONTEXT_REDS;
} else {
- return REDS_IN(current) - current->fcalls;
+ reds_left = c_p->fcalls;
}
+ return REDS_IN(c_p) - reds_left;
}
int
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 69e49e97f3..941c3ebbbe 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -3354,19 +3354,12 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
NATIVE_ENDIAN(Flags);
if (Size.type == TAG_a && Size.val == am_all) {
- if (Ms.type == Dst.type && Ms.val == Dst.val) {
- GENOP_NAME_ARITY(op, i_bs_get_binary_all_reuse, 3);
- op->a[0] = Ms;
- op->a[1] = Fail;
- op->a[2] = Unit;
- } else {
- GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5);
- op->a[0] = Ms;
- op->a[1] = Fail;
- op->a[2] = Live;
- op->a[3] = Unit;
- op->a[4] = Dst;
- }
+ GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5);
+ op->a[0] = Ms;
+ op->a[1] = Fail;
+ op->a[2] = Live;
+ op->a[3] = Unit;
+ op->a[4] = Dst;
} else if (Size.type == TAG_i) {
GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6);
op->a[0] = Ms;
diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab
index 652460a66d..9cad2b03c5 100644
--- a/erts/emulator/beam/bs_instrs.tab
+++ b/erts/emulator/beam/bs_instrs.tab
@@ -1136,7 +1136,6 @@ i_bs_get_utf16.execute(Fail, Flags, Dst) {
}
bs_context_to_binary := ctx_to_bin.fetch.execute;
-i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute;
ctx_to_bin.head() {
Eterm context;
@@ -1159,16 +1158,6 @@ ctx_to_bin.fetch(Src) {
}
}
-ctx_to_bin.fetch_bin(Src, Fail, Unit) {
- context = $Src;
- mb = ms_matchbuffer(context);
- size = mb->size - mb->offset;
- if (size % $Unit != 0) {
- $FAIL($Fail);
- }
- offs = mb->offset;
-}
-
ctx_to_bin.execute() {
Uint hole_size;
Uint orig = mb->orig;
diff --git a/erts/emulator/beam/erl_posix_str.c b/erts/emulator/beam/erl_posix_str.c
index 7b3e640d3f..5b515d6e78 100644
--- a/erts/emulator/beam/erl_posix_str.c
+++ b/erts/emulator/beam/erl_posix_str.c
@@ -171,6 +171,9 @@ erl_errno_id(error)
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
case EIDRM: return "eidrm";
#endif
+#ifdef EILSEQ
+ case EILSEQ: return "eilseq";
+#endif
#ifdef EINIT
case EINIT: return "einit";
#endif
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 880febba8b..430ac305c5 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -69,7 +69,6 @@ int erts_fit_in_bits_int32(Sint32);
int erts_fit_in_bits_uint(Uint);
Sint erts_list_length(Eterm);
int erts_is_builtin(Eterm, Eterm, int);
-Uint32 block_hash(byte *, unsigned, Uint32);
Uint32 make_hash2(Eterm);
Uint32 make_hash(Eterm);
Uint32 make_internal_hash(Eterm, Uint32 salt);
diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab
index 6f8d1469ef..b08466c830 100644
--- a/erts/emulator/beam/msg_instrs.tab
+++ b/erts/emulator/beam/msg_instrs.tab
@@ -105,6 +105,7 @@ i_loop_rec(Dest) {
$SET_CP_I_ABS(I);
c_p->arity = 0;
c_p->current = NULL;
+ c_p->fcalls = FCALLS;
FCALLS -= erts_proc_sig_receive_helper(c_p, FCALLS, neg_o_reds,
&msgp, &get_out);
SWAPIN;
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 3a95b1a37e..7a125b0f67 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1262,7 +1262,6 @@ bs_get_binary2 Fail=f Ms=xy Live=u Sz=sq Unit=u Flags=u Dst=d => \
i_bs_get_binary_imm2 xy f? t W t d
i_bs_get_binary2 xy f t? s t d
i_bs_get_binary_all2 xy f? t t d
-i_bs_get_binary_all_reuse xy f? t
# Fetching float from binaries.
bs_get_float2 Fail=f Ms=xy Live=u Sz=s Unit=u Flags=u Dst=d => \
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 36cfe0548e..0bbae65e28 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1069,11 +1069,11 @@ do { \
#define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */
-Uint32
-block_hash(byte *k, unsigned length, Uint32 initval)
+static Uint32
+block_hash(byte *k, Uint length, Uint32 initval)
{
Uint32 a,b,c;
- unsigned len;
+ Uint len;
/* Set up the internal state */
len = length;
@@ -1749,7 +1749,7 @@ make_internal_hash(Eterm term, Uint32 salt)
case SUB_BINARY_SUBTAG:
{
byte* bptr;
- unsigned sz = binary_size(term);
+ Uint sz = binary_size(term);
Uint32 con = HCONST_13 + hash;
Uint bitoffs;
Uint bitsize;
diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index 17759d78f3..cae4eb54d2 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -24,7 +24,7 @@
kenneth/1,encode_binary/1,native/1,happi/1,
size_var/1,wiger/1,x0_context/1,huge_float_field/1,
writable_binary_matched/1,otp_7198/1,unordered_bindings/1,
- float_middle_endian/1]).
+ float_middle_endian/1,unsafe_get_binary_reuse/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +36,8 @@ all() ->
[bound_var, bound_tail, t_float, little_float, sean,
kenneth, encode_binary, native, happi, size_var, wiger,
x0_context, huge_float_field, writable_binary_matched,
- otp_7198, unordered_bindings, float_middle_endian].
+ otp_7198, unordered_bindings, float_middle_endian,
+ unsafe_get_binary_reuse].
%% Test matching of bound variables.
@@ -556,5 +557,21 @@ unordered_bindings(CompressedLength, HashSize, PadLength, T) ->
Padding:PadLength/binary,PadLength>> = T,
{Content,Mac,Padding}.
+%% ERL-901: A load-time optimization assumed that match contexts had no further
+%% uses when a bs_get_binary2 overwrote the match context's register, and
+%% figured it would be safe to reuse the match context's memory for the
+%% resulting binary.
+%%
+%% This is no longer safe as of OTP 22, as a match context may be reused after
+%% being passed to another function.
+unsafe_get_binary_reuse(Config) when is_list(Config) ->
+ <<_First, Rest/binary>> = <<"hello">>,
+ ubgr_1(Rest),
+ <<Second,_/bits>> = Rest,
+ $e = Second,
+ ok.
+
+ubgr_1(<<_CP/utf8, Rest/binary>>) -> id(Rest);
+ubgr_1(_) -> false.
id(I) -> I.
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index 55c5343739..045b351e02 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -105,34 +105,27 @@ open_files(Name) ->
%% a /proc directory), let's read some zero sized files 500 times each, while
%% ensuring that response isn't empty << >>
proc_zero_sized_files(Config) when is_list(Config) ->
- {Type, Flavor} = os:type(),
- %% Some files which exist on Linux but might be missing on other systems
- Inputs = ["/proc/cpuinfo",
- "/proc/meminfo",
- "/proc/partitions",
- "/proc/swaps",
- "/proc/version",
- "/proc/uptime",
- %% curproc is present on freebsd
- "/proc/curproc/cmdline"],
- case filelib:is_dir("/proc") of
- false -> {skip, "/proc not found"}; % skip the test if no /proc
- _ when Type =:= unix andalso Flavor =:= sunos ->
- %% SunOS has a /proc, but no zero sized special files
- {skip, "sunos does not have any zero sized special files"};
- true ->
- %% Take away files which do not exist in proc
- Inputs1 = lists:filter(fun filelib:is_file/1, Inputs),
-
- %% Fail if none of mentioned files exist in /proc, did we just get
- %% a normal /proc directory without any special files?
- ?assertNotEqual([], Inputs1),
-
+ TestFiles0 = [%% Some files which exist on Linux but might be missing on
+ %% other systems
+ "/proc/cpuinfo",
+ "/proc/meminfo",
+ "/proc/partitions",
+ "/proc/swaps",
+ "/proc/version",
+ "/proc/uptime",
+ %% curproc is present on FreeBSD
+ "/proc/curproc/cmdline"],
+
+ TestFiles = [F || F <- TestFiles0, filelib:is_file(F)],
+
+ case TestFiles of
+ [_|_] ->
%% For 6 inputs and 500 attempts each this do run anywhere
%% between 500 and 3000 function calls.
- lists:foreach(
- fun(Filename) -> do_proc_zero_sized(Filename, 500) end,
- Inputs1)
+ [do_proc_zero_sized(F, 500) || F <- TestFiles],
+ ok;
+ [] ->
+ {skip, "Failed to find any known zero-sized files"}
end.
%% @doc Test one file N times to also trigger possible leaking fds and memory
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index d0a6763fe5..9ea59e1084 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -17,7 +17,7 @@
%% %CopyrightEnd%
%%
-module(map_SUITE).
--export([all/0, suite/0]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]).
-export([t_build_and_match_literals/1, t_build_and_match_literals_large/1,
t_update_literals/1, t_update_literals_large/1,
@@ -84,7 +84,10 @@
%% instruction-level tests
t_has_map_fields/1,
y_regs/1,
- badmap_17/1]).
+ badmap_17/1,
+
+ %%Bugs
+ t_large_unequal_bins_same_hash_bug/1]).
-include_lib("stdlib/include/ms_transform.hrl").
@@ -149,7 +152,26 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large,
%% instruction-level tests
t_has_map_fields,
y_regs,
- badmap_17].
+ badmap_17,
+
+ %% Bugs
+ t_large_unequal_bins_same_hash_bug].
+
+init_per_suite(Config) ->
+ A0 = case application:start(sasl) of
+ ok -> [sasl];
+ _ -> []
+ end,
+ A = case application:start(os_mon) of
+ ok -> [os_mon|A0];
+ _ -> A0
+ end,
+ [{started_apps, A}|Config].
+
+end_per_suite(Config) ->
+ As = proplists:get_value(started_apps, Config),
+ lists:foreach(fun (A) -> application:stop(A) end, As),
+ Config.
%% tests
@@ -3374,3 +3396,67 @@ fannerl() ->
104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174,
254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97,
16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>.
+
+%% This test case checks that the bug with ticket number OTP-15707 is
+%% fixed. The bug could cause a crash or memory usage to grow until
+%% the machine ran out of memory.
+t_large_unequal_bins_same_hash_bug(Config) when is_list(Config) ->
+ run_when_enough_resources(
+ fun() ->
+ K1 = get_4GB_bin(1),
+ K2 = get_4GB_bin(2),
+ Map = make_map(500),
+ Map2 = maps:put(K1, 42, Map),
+ %% The map needed to contain at least 32 key-value pairs
+ %% at this point to get the crash or out of memory
+ %% problem on the next line
+ Map3 = maps:put(K2, 43, Map2),
+ %% The following line should avoid that the compiler
+ %% optimizes away the above
+ io:format("~p ~p~n", [erlang:phash2(Map3), maps:size(Map3)])
+ end).
+
+make_map(0) ->
+ #{};
+make_map(Size) ->
+ maps:put(Size, Size, make_map(Size-1)).
+
+get_4GB_bin(Value) ->
+ List = lists:duplicate(65536, Value),
+ Bin = erlang:iolist_to_binary(List),
+ IOList4GB = duplicate_iolist(Bin, 16),
+ Bin4GB = erlang:iolist_to_binary(IOList4GB),
+ 4294967296 = size(Bin4GB),
+ Bin4GB.
+
+duplicate_iolist(IOList, 0) ->
+ IOList;
+duplicate_iolist(IOList, NrOfTimes) ->
+ duplicate_iolist([IOList, IOList], NrOfTimes - 1).
+
+run_when_enough_resources(Fun) ->
+ case {total_memory(), erlang:system_info(wordsize)} of
+ {Mem, 8} when is_integer(Mem) andalso Mem >= 31 ->
+ Fun();
+ {Mem, WordSize} ->
+ {skipped,
+ io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)",
+ [Mem, WordSize])}
+ end.
+
+total_memory() ->
+ %% Total memory in GB.
+ try
+ MemoryData = memsup:get_system_memory_data(),
+ case lists:keysearch(total_memory, 1, MemoryData) of
+ {value, {total_memory, TM}} ->
+ TM div (1024*1024*1024);
+ false ->
+ {value, {system_total_memory, STM}} =
+ lists:keysearch(system_total_memory, 1, MemoryData),
+ STM div (1024*1024*1024)
+ end
+ catch
+ _ : _ ->
+ undefined
+ end.
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index c698220013..b530ced566 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -44,6 +44,7 @@
process_info_garbage_collection/1,
process_info_smoke_all/1,
process_info_status_handled_signal/1,
+ process_info_reductions/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1,
@@ -84,6 +85,7 @@ all() ->
process_info_garbage_collection,
process_info_smoke_all,
process_info_status_handled_signal,
+ process_info_reductions,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -1093,6 +1095,46 @@ process_info_status_handled_signal(Config) when is_list(Config) ->
false = erlang:is_process_alive(P),
ok.
+%% OTP-15709
+%% Provoke a bug where process_info(reductions) returned wrong result
+%% because REDS_IN (def_arg_reg[5]) is read when the process in not running.
+process_info_reductions(Config) when is_list(Config) ->
+ pi_reductions_tester(spawn_link(fun() -> pi_reductions_spinnloop() end)),
+ pi_reductions_tester(spawn_link(fun() -> pi_reductions_recvloop() end)),
+ ok.
+
+pi_reductions_tester(Pid) ->
+ {_, DiffList} =
+ lists:foldl(fun(_, {Prev, Acc}) ->
+ %% Add another item that force sending the request
+ %% as a signal, like 'current_function'.
+ PI = process_info(Pid, [reductions, current_function]),
+ [{reductions,Reds}, {current_function,_}] = PI,
+ Diff = Reds - Prev,
+ {Diff, true} = {Diff, (Diff >= 0)},
+ {Diff, true} = {Diff, (Diff =< 1000*1000)},
+ {Reds, [Diff | Acc]}
+ end,
+ {0, []},
+ lists:seq(1,10)),
+ unlink(Pid),
+ exit(Pid,kill),
+ io:format("Reduction diffs: ~p\n", [DiffList]),
+ ok.
+
+pi_reductions_spinnloop() ->
+ %% 6 args to make use of def_arg_reg[5] which is also used as REDS_IN
+ pi_reductions_spinnloop(1, atom, "hej", self(), make_ref(), 3.14).
+
+pi_reductions_spinnloop(A,B,C,D,E,F) ->
+ pi_reductions_spinnloop(B,C,D,E,F,A).
+
+pi_reductions_recvloop() ->
+ receive
+ "a free lunch" -> false
+ end.
+
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
diff --git a/erts/vsn.mk b/erts/vsn.mk
index 3942af7f78..bce5ce4167 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 10.3.1
+VSN = 10.3.2
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index 7a304e6d4f..be7a2a6b0e 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -659,7 +659,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname,
return ERL_ERROR;
}
- ec->creation = creation & 0x3; /* 2 bits */
+ ec->creation = creation;
if (cookie) {
if (strlen(cookie) >= sizeof(ec->ei_connect_cookie)) {
@@ -698,7 +698,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname,
strcpy(ec->self.node,thisnodename);
ec->self.num = 0;
ec->self.serial = 0;
- ec->self.creation = creation & 0x3; /* 2 bits */
+ ec->self.creation = creation;
ec->cbs = cbs;
ec->setup_context = setup_context;
diff --git a/lib/erl_interface/src/epmd/ei_epmd.h b/lib/erl_interface/src/epmd/ei_epmd.h
index ac153b6e66..f72c354e32 100644
--- a/lib/erl_interface/src/epmd/ei_epmd.h
+++ b/lib/erl_interface/src/epmd/ei_epmd.h
@@ -25,8 +25,8 @@
#endif
#ifndef EI_DIST_HIGH
-#define EI_DIST_HIGH 5 /* R4 and later */
-#define EI_DIST_LOW 1 /* R3 and earlier */
+#define EI_DIST_HIGH 6 /* OTP 22 and later */
+#define EI_DIST_LOW 5 /* OTP R4 - 21 */
#endif
#ifndef EPMD_PORT
@@ -45,6 +45,7 @@
#ifndef EI_EPMD_ALIVE2_REQ
#define EI_EPMD_ALIVE2_REQ 120
#define EI_EPMD_ALIVE2_RESP 121
+#define EI_EPMD_ALIVE2_X_RESP 118
#define EI_EPMD_PORT2_REQ 122
#define EI_EPMD_PORT2_RESP 119
#define EI_EPMD_STOP_REQ 's'
diff --git a/lib/erl_interface/src/epmd/epmd_publish.c b/lib/erl_interface/src/epmd/epmd_publish.c
index 20b8e867e8..ef8a5d6b70 100644
--- a/lib/erl_interface/src/epmd/epmd_publish.c
+++ b/lib/erl_interface/src/epmd/epmd_publish.c
@@ -68,7 +68,8 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
int nlen = strlen(alive);
int len = elen + nlen + 13; /* hard coded: be careful! */
int n;
- int err, res, creation;
+ int err, response, res;
+ unsigned creation;
ssize_t dlen;
unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms;
@@ -124,8 +125,10 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
/* Don't close fd here! It keeps us registered with epmd */
s = buf;
- if (((res=get8(s)) != EI_EPMD_ALIVE2_RESP)) { /* response */
- EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",res);
+ response = get8(s);
+ if (response != EI_EPMD_ALIVE2_RESP &&
+ response != EI_EPMD_ALIVE2_X_RESP) {
+ EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",response);
EI_TRACE_ERR0("ei_epmd_r4_publish","-> CLOSE");
ei_close__(fd);
erl_errno = EIO;
@@ -141,18 +144,21 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
return -1;
}
- creation = get16be(s);
+ if (response == EI_EPMD_ALIVE2_RESP)
+ creation = get16be(s);
+ else /* EI_EPMD_ALIVE2_X_RESP */
+ creation = get32be(s);
EI_TRACE_CONN2("ei_epmd_r4_publish",
- " result=%d (ok) creation=%d",res,creation);
+ " result=%d (ok) creation=%u",res,creation);
- /* probably should save fd so we can close it later... */
- /* epmd_saveconn(OPEN,fd,alive); */
+ /*
+ * Would be nice to somehow use the nice "unique" creation value
+ * received here from epmd instead of using the crappy one
+ * passed (already) to ei_connect_init.
+ */
- /* return the creation number, for no good reason */
- /* return creation;*/
-
- /* no - return the descriptor */
+ /* return the descriptor */
return fd;
}
diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c
index ab91157035..dce2ecdec2 100644
--- a/lib/erl_interface/src/prog/erl_call.c
+++ b/lib/erl_interface/src/prog/erl_call.c
@@ -292,8 +292,7 @@ int erl_call(int argc, char **argv)
flags.cookie = NULL;
}
- /* FIXME decide how many bits etc or leave to connect_xinit? */
- creation = (time(NULL) % 3) + 1; /* "random" */
+ creation = time(NULL) + 1; /* "random" */
if (flags.hidden == NULL) {
/* As default we are c17@gethostname */
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
index 9cbd735751..3abdf9535f 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
@@ -27,7 +27,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
// don't change this!
private static final long serialVersionUID = 1664394142301803659L;
- private final int tag;
private final String node;
private final int id;
private final int serial;
@@ -45,7 +44,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
public OtpErlangPid(final OtpLocalNode self) {
final OtpErlangPid p = self.createPid();
- tag = p.tag;
id = p.id;
serial = p.serial;
creation = p.creation;
@@ -67,7 +65,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
throws OtpErlangDecodeException {
final OtpErlangPid p = buf.read_pid();
- tag = p.tag;
node = p.node();
id = p.id();
serial = p.serial();
@@ -118,7 +115,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
*/
protected OtpErlangPid(final int tag, final String node, final int id,
final int serial, final int creation) {
- this.tag = tag;
this.node = node;
if (tag == OtpExternal.pidTag) {
this.id = id & 0x7fff; // 15 bits
@@ -133,7 +129,7 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
}
protected int tag() {
- return tag;
+ return OtpExternal.newPidTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
index 79b5d2736c..c8648d7aa3 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
@@ -26,7 +26,6 @@ public class OtpErlangPort extends OtpErlangObject {
// don't change this!
private static final long serialVersionUID = 4037115468007644704L;
- private final int tag;
private final String node;
private final int id;
private final int creation;
@@ -43,7 +42,6 @@ public class OtpErlangPort extends OtpErlangObject {
private OtpErlangPort(final OtpSelf self) {
final OtpErlangPort p = self.createPort();
- tag = p.tag;
id = p.id;
creation = p.creation;
node = p.node;
@@ -64,7 +62,6 @@ public class OtpErlangPort extends OtpErlangObject {
throws OtpErlangDecodeException {
final OtpErlangPort p = buf.read_port();
- tag = p.tag;
node = p.node();
id = p.id();
creation = p.creation();
@@ -105,7 +102,6 @@ public class OtpErlangPort extends OtpErlangObject {
*/
public OtpErlangPort(final int tag, final String node, final int id,
final int creation) {
- this.tag = tag;
this.node = node;
if (tag == OtpExternal.portTag) {
this.id = id & 0xfffffff; // 28 bits
@@ -118,7 +114,7 @@ public class OtpErlangPort extends OtpErlangObject {
}
protected int tag() {
- return tag;
+ return OtpExternal.newPortTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
index 2165397013..2bf8d9a56b 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
@@ -28,7 +28,6 @@ public class OtpErlangRef extends OtpErlangObject {
// don't change this!
private static final long serialVersionUID = -7022666480768586521L;
- private final int tag;
private final String node;
private final int creation;
@@ -49,7 +48,6 @@ public class OtpErlangRef extends OtpErlangObject {
public OtpErlangRef(final OtpLocalNode self) {
final OtpErlangRef r = self.createRef();
- tag = r.tag;
ids = r.ids;
creation = r.creation;
node = r.node;
@@ -70,7 +68,6 @@ public class OtpErlangRef extends OtpErlangObject {
throws OtpErlangDecodeException {
final OtpErlangRef r = buf.read_ref();
- tag = r.tag;
node = r.node();
creation = r.creation();
@@ -90,7 +87,6 @@ public class OtpErlangRef extends OtpErlangObject {
* another arbitrary number.
*/
public OtpErlangRef(final String node, final int id, final int creation) {
- this.tag = OtpExternal.newRefTag;
this.node = node;
ids = new int[1];
ids[0] = id & 0x3ffff; // 18 bits
@@ -138,7 +134,6 @@ public class OtpErlangRef extends OtpErlangObject {
*/
public OtpErlangRef(final int tag, final String node, final int[] ids,
final int creation) {
- this.tag = tag;
this.node = node;
// use at most 3 words
@@ -162,7 +157,7 @@ public class OtpErlangRef extends OtpErlangObject {
}
protected int tag() {
- return tag;
+ return OtpExternal.newerRefTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
index 187705a0b5..a3b089c1da 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
@@ -713,7 +713,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
*/
public void write_pid(final String node, final int id, final int serial,
final int creation) {
- write1(OtpExternal.pidTag);
+ write1(OtpExternal.newPidTag);
write_atom(node);
write4BE(id & 0x7fff); // 15 bits
write4BE(serial & 0x1fff); // 13 bits
@@ -727,20 +727,11 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* the pid
*/
public void write_pid(OtpErlangPid pid) {
- write1(pid.tag());
+ write1(OtpExternal.newPidTag);
write_atom(pid.node());
write4BE(pid.id());
write4BE(pid.serial());
- switch (pid.tag()) {
- case OtpExternal.pidTag:
- write1(pid.creation());
- break;
- case OtpExternal.newPidTag:
- write4BE(pid.creation());
- break;
- default:
- throw new AssertionError("Invalid pid tag " + pid.tag());
- }
+ write4BE(pid.creation());
}
@@ -758,7 +749,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* be used.
*/
public void write_port(final String node, final int id, final int creation) {
- write1(OtpExternal.portTag);
+ write1(OtpExternal.newPortTag);
write_atom(node);
write4BE(id & 0xfffffff); // 28 bits
write1(creation & 0x3); // 2 bits
@@ -771,19 +762,10 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* the port.
*/
public void write_port(OtpErlangPort port) {
- write1(port.tag());
+ write1(OtpExternal.newPortTag);
write_atom(port.node());
write4BE(port.id());
- switch (port.tag()) {
- case OtpExternal.portTag:
- write1(port.creation());
- break;
- case OtpExternal.newPortTag:
- write4BE(port.creation());
- break;
- default:
- throw new AssertionError("Invalid port tag " + port.tag());
- }
+ write4BE(port.creation());
}
/**
@@ -829,7 +811,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
arity = 3; // max 3 words in ref
}
- write1(OtpExternal.newRefTag);
+ write1(OtpExternal.newerRefTag);
// how many id values
write2BE(arity);
@@ -857,24 +839,12 @@ public class OtpOutputStream extends ByteArrayOutputStream {
int[] ids = ref.ids();
int arity = ids.length;
- write1(ref.tag());
+ write1(OtpExternal.newerRefTag);
write2BE(arity);
write_atom(ref.node());
+ write4BE(ref.creation());
- switch (ref.tag()) {
- case OtpExternal.newRefTag:
- write1(ref.creation());
- write4BE(ids[0] & 0x3ffff); // first word gets truncated to 18 bits
- break;
- case OtpExternal.newerRefTag:
- write4BE(ref.creation());
- write4BE(ids[0]); // full first word
- break;
- default:
- throw new AssertionError("Invalid ref tag " + ref.tag());
- }
-
- for (int i = 1; i < arity; i++) {
+ for (int i = 0; i < arity; i++) {
write4BE(ids[i]);
}
}
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
index 0c187eb19f..61bd598145 100644
--- a/lib/kernel/doc/src/notes.xml
+++ b/lib/kernel/doc/src/notes.xml
@@ -31,6 +31,21 @@
</header>
<p>This document describes the changes made to the Kernel application.</p>
+<section><title>Kernel 6.3.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed a performance regression when reading files
+ opened with the <c>compressed</c> flag.</p>
+ <p>
+ Own Id: OTP-15706 Aux Id: ERIERL-336 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Kernel 6.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index 8fa3f5c588..aca3247c8f 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -43,7 +43,9 @@
{<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^6\\.2$">>,[restart_new_emulator]},
{<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
+ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.3$">>,[restart_new_emulator]},
+ {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}],
[{<<"^5\\.3$">>,[restart_new_emulator]},
{<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
@@ -60,4 +62,6 @@
{<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^6\\.2$">>,[restart_new_emulator]},
{<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
+ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.3$">>,[restart_new_emulator]},
+ {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}.
diff --git a/lib/kernel/src/raw_file_io_inflate.erl b/lib/kernel/src/raw_file_io_inflate.erl
index 7e9780310c..d3ed02dd03 100644
--- a/lib/kernel/src/raw_file_io_inflate.erl
+++ b/lib/kernel/src/raw_file_io_inflate.erl
@@ -26,7 +26,7 @@
-include("file_int.hrl").
--define(INFLATE_CHUNK_SIZE, (1 bsl 10)).
+-define(INFLATE_CHUNK_SIZE, (8 bsl 10)).
-define(GZIP_WBITS, (16 + 15)).
callback_mode() -> state_functions.
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 711ffccb67..e095e589a3 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -3744,19 +3744,33 @@ otp_10852(Config) when is_list(Config) ->
ok = rpc_call(Node, read_file, [B]),
ok = rpc_call(Node, make_link, [B,B]),
case rpc_call(Node, make_symlink, [B,B]) of
- ok -> ok;
- {error, E} when (E =:= enotsup) or (E =:= eperm) ->
- {win32,_} = os:type()
+ {error, eilseq} ->
+ %% Some versions of OS X refuse to create files with illegal names.
+ {unix,darwin} = os:type();
+ {error, eperm} ->
+ %% The test user might not have permission to create symlinks.
+ {win32,_} = os:type();
+ ok ->
+ ok
end,
ok = rpc_call(Node, delete, [B]),
- ok = rpc_call(Node, make_dir, [B]),
+ case rpc_call(Node, make_dir, [B]) of
+ {error, eilseq} ->
+ {unix,darwin} = os:type();
+ ok ->
+ ok
+ end,
ok = rpc_call(Node, del_dir, [B]),
- ok = rpc_call(Node, write_file, [B,B]),
- {ok, Fd} = rpc_call(Node, open, [B,[read]]),
- ok = rpc_call(Node, close, [Fd]),
- {ok,0} = rpc_call(Node, copy, [B,B]),
- {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]),
- ok = rpc_call(Node, close, [Fd2]),
+ case rpc_call(Node, write_file, [B,B]) of
+ {error, eilseq} ->
+ {unix,darwin} = os:type();
+ ok ->
+ {ok, Fd} = rpc_call(Node, open, [B,[read]]),
+ ok = rpc_call(Node, close, [Fd]),
+ {ok,0} = rpc_call(Node, copy, [B,B]),
+ {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]),
+ ok = rpc_call(Node, close, [Fd2])
+ end,
true = test_server:stop_node(Node),
ok.
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index 3afc647081..26cfd187c7 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -632,10 +632,13 @@ make_icky_dir(Mod, IckyDirName) ->
hopeless_darwin() ->
case {os:type(),os:version()} of
- {{unix,darwin},{Major,_,_}} when Major < 9 ->
- true;
- _ ->
- false
+ {{unix,darwin},{Major,_,_}} ->
+ %% icky file names worked between 10 and 17, but started returning
+ %% EILSEQ in 18. The check against 18 is exact in case newer
+ %% versions of Darwin support them again.
+ Major < 9 orelse Major =:= 18;
+ _ ->
+ false
end.
make_very_icky_dir(Mod, DirName) ->
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
index 7bebe1ba70..b1ae513223 100644
--- a/lib/kernel/vsn.mk
+++ b/lib/kernel/vsn.mk
@@ -1 +1 @@
-KERNEL_VSN = 6.3
+KERNEL_VSN = 6.3.1
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 30b2ab7c4f..7993be8a74 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -193,7 +193,8 @@ next_event(StateName, no_record,
%% TODO maybe buffer later epoch
next_event(StateName, no_record, State, Actions);
{#alert{} = Alert, State} ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ Version = State#state.connection_env#connection_env.negotiated_version,
+ handle_own_alert(Alert, Version, StateName, State)
end;
next_event(connection = StateName, Record,
#state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
@@ -233,7 +234,8 @@ next_event(StateName, Record,
%% TODO maybe buffer later epoch
next_event(StateName, no_record, State0, Actions);
#alert{} = Alert ->
- {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]}
+ Version = State0#state.connection_env#connection_env.negotiated_version,
+ handle_own_alert(Alert, Version, StateName, State0)
end.
%%% DTLS record protocol level application data messages
@@ -1075,10 +1077,10 @@ start_retransmision_timer(Timeout, #state{protocol_specific = PS} = State) ->
{State#state{protocol_specific = PS#{flight_state => {retransmit, new_timeout(Timeout)}}},
[{state_timeout, Timeout, flight_retransmission_timeout}]}.
-new_timeout(N) when N =< 30 ->
+new_timeout(N) when N =< 30000 ->
N * 2;
new_timeout(_) ->
- 60.
+ 60000.
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl
index e0423b07b4..2e9184b7ac 100644
--- a/lib/ssl/src/dtls_packet_demux.erl
+++ b/lib/ssl/src/dtls_packet_demux.erl
@@ -203,9 +203,9 @@ dispatch(Client, Msg, #state{dtls_msq_queues = MsgQueues} = State) ->
Pid ! Msg,
State#state{dtls_msq_queues =
kv_update(Client, Queue, MsgQueues)};
- {{value, _}, Queue} ->
+ {{value, _UDP}, _Queue} ->
State#state{dtls_msq_queues =
- kv_update(Client, queue:in(Msg, Queue), MsgQueues)};
+ kv_update(Client, queue:in(Msg, Queue0), MsgQueues)};
{empty, Queue} ->
State#state{dtls_msq_queues =
kv_update(Client, queue:in(Msg, Queue), MsgQueues)}
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index e7fab7ebc5..8d9b92361b 100644
--- a/lib/ssl/src/inet_tls_dist.erl
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2019. 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.
@@ -132,8 +132,8 @@ f_recv(SslSocket, Length, Timeout) ->
f_setopts_pre_nodeup(_SslSocket) ->
ok.
-f_setopts_post_nodeup(_SslSocket) ->
- ok.
+f_setopts_post_nodeup(SslSocket) ->
+ ssl:setopts(SslSocket, [nodelay()]).
f_getll(DistCtrl) ->
{ok, DistCtrl}.
@@ -199,7 +199,7 @@ listen(Name) ->
gen_listen(Driver, Name) ->
case inet_tcp_dist:gen_listen(Driver, Name) of
{ok, {Socket, Address, Creation}} ->
- inet:setopts(Socket, [{packet, 4}]),
+ inet:setopts(Socket, [{packet, 4}, {nodelay, true}]),
{ok, {Socket, Address#net_address{protocol=tls}, Creation}};
Other ->
Other
@@ -532,7 +532,7 @@ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNo
case ssl:connect(
Address, TcpPort,
[binary, {active, false}, {packet, 4},
- Driver:family(), nodelay()] ++ Opts,
+ Driver:family(), {nodelay, true}] ++ Opts,
net_kernel:connecttime()) of
{ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} ->
_ = monitor_pid(DistCtrl),
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index c7c96370b3..8807c575b1 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -112,6 +112,10 @@
aes_256_cbc |
aes_128_gcm |
aes_256_gcm |
+ aes_128_ccm |
+ aes_256_ccm |
+ aes_128_ccm_8 |
+ aes_256_ccm_8 |
chacha20_poly1305 |
legacy_cipher().
-type legacy_cipher() :: rc4_128 |
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index fe8736d2df..97878431a6 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -35,7 +35,7 @@
-include_lib("public_key/include/public_key.hrl").
-export([security_parameters/2, security_parameters/3, security_parameters_1_3/2,
- cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/5, aead_decrypt/6,
+ cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/6, aead_decrypt/6,
suites/1, all_suites/1, crypto_support_filters/0,
chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1,
srp_suites/0, srp_suites_anon/0,
@@ -106,9 +106,13 @@ security_parameters_1_3(SecParams, CipherSuite) ->
cipher_init(?RC4, IV, Key) ->
State = crypto:stream_init(rc4, Key),
#cipher_state{iv = IV, key = Key, state = State};
-cipher_init(?AES_GCM, IV, Key) ->
+cipher_init(Type, IV, Key) when Type == ?AES_GCM;
+ Type == ?AES_CCM ->
<<Nonce:64>> = random_bytes(8),
#cipher_state{iv = IV, key = Key, nonce = Nonce, tag_len = 16};
+cipher_init(?AES_CCM_8, IV, Key) ->
+ <<Nonce:64>> = random_bytes(8),
+ #cipher_state{iv = IV, key = Key, nonce = Nonce, tag_len = 8};
cipher_init(?CHACHA20_POLY1305, IV, Key) ->
#cipher_state{iv = IV, key = Key, tag_len = 16};
cipher_init(_BCA, IV, Key) ->
@@ -148,14 +152,18 @@ cipher(?AES_CBC, CipherState, Mac, Fragment, Version) ->
crypto:block_encrypt(aes_cbc256, Key, IV, T)
end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version).
-aead_encrypt(Type, Key, Nonce, Fragment, AdditionalData) ->
- crypto:block_encrypt(aead_type(Type), Key, Nonce, {AdditionalData, Fragment}).
+aead_encrypt(Type, Key, Nonce, Fragment, AdditionalData, TagLen) ->
+ crypto:block_encrypt(aead_type(Type), Key, Nonce, {AdditionalData, Fragment, TagLen}).
aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AdditionalData) ->
crypto:block_decrypt(aead_type(Type), Key, Nonce, {AdditionalData, CipherText, CipherTag}).
aead_type(?AES_GCM) ->
aes_gcm;
+aead_type(?AES_CCM) ->
+ aes_ccm;
+aead_type(?AES_CCM_8) ->
+ aes_ccm;
aead_type(?CHACHA20_POLY1305) ->
chacha20_poly1305.
@@ -311,8 +319,7 @@ anonymous_suites({254, _} = Version) ->
dtls_v1:anonymous_suites(Version);
anonymous_suites(4) ->
[]; %% Raw public key negotiation may be used instead
-anonymous_suites(N)
- when N >= 3 ->
+anonymous_suites( 3 = N) ->
psk_suites_anon(N) ++
[?TLS_DH_anon_WITH_AES_128_GCM_SHA256,
?TLS_DH_anon_WITH_AES_256_GCM_SHA384,
@@ -347,8 +354,7 @@ psk_suites({3, N}) ->
psk_suites(N);
psk_suites(4) ->
[]; %% TODO Add new PSK, PSK_(EC)DHE suites
-psk_suites(N)
- when N >= 3 ->
+psk_suites(3) ->
[
?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384,
?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
@@ -369,20 +375,32 @@ psk_suites(_) ->
%%--------------------------------------------------------------------
psk_suites_anon({3, N}) ->
psk_suites_anon(N);
-psk_suites_anon(N)
- when N >= 3 ->
+psk_suites_anon(3) ->
[
?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384,
?TLS_PSK_WITH_AES_256_GCM_SHA384,
?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384,
?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384,
?TLS_PSK_WITH_AES_256_CBC_SHA384,
+ ?TLS_DHE_PSK_WITH_AES_256_CCM,
+ ?TLS_PSK_DHE_WITH_AES_256_CCM_8,
+ ?TLS_PSK_WITH_AES_256_CCM,
+ ?TLS_PSK_WITH_AES_256_CCM_8,
?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256,
+ ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256,
?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256,
?TLS_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256,
?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256,
?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256,
- ?TLS_PSK_WITH_AES_128_CBC_SHA256
+ ?TLS_PSK_WITH_AES_128_CBC_SHA256,
+ ?TLS_DHE_PSK_WITH_AES_128_CCM,
+ ?TLS_PSK_DHE_WITH_AES_128_CCM_8,
+ ?TLS_PSK_WITH_AES_128_CCM,
+ ?TLS_PSK_WITH_AES_128_CCM_8,
+ ?TLS_ECDHE_PSK_WITH_RC4_128_SHA
] ++ psk_suites_anon(0);
psk_suites_anon(_) ->
[?TLS_DHE_PSK_WITH_AES_256_CBC_SHA,
@@ -589,7 +607,7 @@ is_acceptable_keyexchange(dhe_rsa, Algos) ->
proplists:get_bool(dh, Algos) andalso
proplists:get_bool(rsa, Algos);
is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_anon;
- KeyExchange == ecdhe_psk ->
+ KeyExchange == ecdhe_psk ->
proplists:get_bool(ecdh, Algos);
is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_ecdsa;
KeyExchange == ecdhe_ecdsa ->
@@ -629,6 +647,12 @@ is_acceptable_cipher(Cipher, Algos)
when Cipher == aes_128_gcm;
Cipher == aes_256_gcm ->
proplists:get_bool(aes_gcm, Algos);
+is_acceptable_cipher(Cipher, Algos)
+ when Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8 ->
+ proplists:get_bool(aes_ccm, Algos);
is_acceptable_cipher(Cipher, Algos) ->
proplists:get_bool(Cipher, Algos).
@@ -721,6 +745,12 @@ bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc;
bulk_cipher_algorithm(Cipher) when Cipher == aes_128_gcm;
Cipher == aes_256_gcm ->
?AES_GCM;
+bulk_cipher_algorithm(Cipher) when Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm ->
+ ?AES_CCM;
+bulk_cipher_algorithm(Cipher) when Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8 ->
+ ?AES_CCM_8;
bulk_cipher_algorithm(chacha20_poly1305) ->
?CHACHA20_POLY1305.
@@ -735,6 +765,10 @@ type(Cipher) when Cipher == des_cbc;
?BLOCK;
type(Cipher) when Cipher == aes_128_gcm;
Cipher == aes_256_gcm;
+ Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8;
Cipher == chacha20_poly1305 ->
?AEAD.
@@ -752,8 +786,16 @@ key_material(aes_256_cbc) ->
32;
key_material(aes_128_gcm) ->
16;
+key_material(aes_128_ccm) ->
+ 16;
+key_material(aes_128_ccm_8) ->
+ 16;
key_material(aes_256_gcm) ->
32;
+key_material(aes_256_ccm_8) ->
+ 32;
+key_material(aes_256_ccm) ->
+ 32;
key_material(chacha20_poly1305) ->
32.
@@ -769,6 +811,10 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc;
Cipher == aes_256_cbc;
Cipher == aes_128_gcm;
Cipher == aes_256_gcm;
+ Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8;
Cipher == chacha20_poly1305 ->
unknown.
@@ -778,12 +824,16 @@ effective_key_bits(des_cbc) ->
56;
effective_key_bits(Cipher) when Cipher == rc4_128;
Cipher == aes_128_cbc;
- Cipher == aes_128_gcm ->
+ Cipher == aes_128_gcm;
+ Cipher == aes_128_ccm;
+ Cipher == aes_128_ccm_8 ->
128;
effective_key_bits('3des_ede_cbc') ->
168;
effective_key_bits(Cipher) when Cipher == aes_256_cbc;
Cipher == aes_256_gcm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_256_ccm_8;
Cipher == chacha20_poly1305 ->
256.
@@ -792,7 +842,11 @@ iv_size(Cipher) when Cipher == null;
Cipher == chacha20_poly1305->
0;
iv_size(Cipher) when Cipher == aes_128_gcm;
- Cipher == aes_256_gcm ->
+ Cipher == aes_256_gcm;
+ Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8 ->
4;
iv_size(Cipher) ->
block_size(Cipher).
@@ -804,6 +858,10 @@ block_size(Cipher) when Cipher == aes_128_cbc;
Cipher == aes_256_cbc;
Cipher == aes_128_gcm;
Cipher == aes_256_gcm;
+ Cipher == aes_128_ccm;
+ Cipher == aes_256_ccm;
+ Cipher == aes_128_ccm_8;
+ Cipher == aes_256_ccm_8;
Cipher == chacha20_poly1305 ->
16.
diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl
index 00822ad9de..9c5e2f80a9 100644
--- a/lib/ssl/src/ssl_cipher.hrl
+++ b/lib/ssl/src/ssl_cipher.hrl
@@ -601,16 +601,82 @@
%% TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x32};
-define(TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#32)>>).
-%%% Chacha20/Poly1305 Suites draft-agl-tls-chacha20poly1305-04
-%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x13}
--define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#13)>>).
+%%% ChaCha20-Poly1305 Cipher Suites for Transport Layer Security (TLS) RFC7905
-%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14}
--define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>).
+%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA8}
+-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A8)>>).
+
+%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA9}
+-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A9)>>).
+
+%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAA}
+-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AA)>>).
+
+%% TLS_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAB}
+-define(TLS_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AB)>>).
+
+%% TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAC}
+-define(TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AC)>>).
+
+%% TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAD}
+-define(TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AD)>>).
+
+%% TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAE}
+-define(TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AE)>>).
+
+
+
+%% RFC 6655 - TLS-1.2 cipher suites
+
+%% TLS_RSA_WITH_AES_128_CCM = {0xC0,0x9C}
+-define(TLS_RSA_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#9C)>>).
+
+%% TLS_RSA_WITH_AES_256_CCM = {0xC0,0x9D}
+-define(TLS_RSA_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#9D)>>).
+
+%% TLS_DHE_RSA_WITH_AES_256_CCM = {0xC0,0x9E}
+-define(TLS_DHE_RSA_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#9E)>>).
+
+%% TLS_DHE_RSA_WITH_AES_128_CCM = {0xC0,0x9F}
+-define(TLS_DHE_RSA_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#9F)>>).
+
+%% TLS_RSA_WITH_AES_256_CCM_8 = {0xC0,0x9A0}
+-define(TLS_RSA_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A0)>>).
+
+%% TLS_RSA_WITH_AES_128_CCM_8 = {0xC0,0xA1}
+-define(TLS_RSA_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A1)>>).
+
+%% TLS_DHE_RSA_WITH_AES_128_CCM_8 = {0xC0,0xA2}
+-define(TLS_DHE_RSA_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A2)>>).
+
+%% TLS_DHE_RSA_WITH_AES_256_CCM_8 = {0xC0,0xA3}
+-define(TLS_DHE_RSA_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A3)>>).
+
+%% TLS_PSK_WITH_AES_128_CCM = {0xC0,0xA4}
+-define(TLS_PSK_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#A4)>>).
+
+%% TLS_PSK_WITH_AES_256_CCM = {0xC0,0xA5)
+-define(TLS_PSK_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#A5)>>).
+
+%% TLS_DHE_PSK_WITH_AES_128_CCM = {0xC0,0xA6}
+-define(TLS_DHE_PSK_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#A6)>>).
+
+%% TLS_DHE_PSK_WITH_AES_256_CCM = {0xC0,0xA7}
+-define(TLS_DHE_PSK_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#A7)>>).
+
+%% TLS_PSK_WITH_AES_128_CCM_8 = {0xC0,0xA8}
+-define(TLS_PSK_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A8)>>).
+
+%% TLS_PSK_WITH_AES_256_CCM_8 = {0xC0,0xA9)
+-define(TLS_PSK_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A9)>>).
+
+%% TLS_PSK_DHE_WITH_AES_128_CCM_8 = {0xC0,0xAA}
+-define(TLS_PSK_DHE_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#AA)>>).
+
+%% TLS_PSK_DHE_WITH_AES_256_CCM_8 = << ?BYTE(0xC0,0xAB}
+-define(TLS_PSK_DHE_WITH_AES_256_CCM_8, <<?BYTE(16#C0),?BYTE(16#AB)>>).
-%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15}
--define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>).
%%% TLS 1.3 cipher suites RFC8446
diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl
index b592295d56..8737181922 100644
--- a/lib/ssl/src/ssl_cipher_format.erl
+++ b/lib/ssl/src/ssl_cipher_format.erl
@@ -467,16 +467,16 @@ suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) ->
cipher => aes_256_gcm,
mac => null,
prf => sha384};
-%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) ->
-%% #{key_exchange => ecdhe_psk,
-%% cipher => aes_128_ccm,
-%% mac => null,
-%% prf =>sha256};
-%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) ->
-%% #{key_exchange => ecdhe_psk,
-%% cipher => aes_256_ccm,
-%% mac => null,
-%% prf => sha256};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_128_ccm,
+ mac => null,
+ prf =>sha256};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_128_ccm_8,
+ mac => null,
+ prf =>sha256};
%%% SRP Cipher Suites RFC 5054
suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) ->
#{key_exchange => srp_anon,
@@ -792,7 +792,53 @@ suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) ->
cipher => aes_256_gcm,
mac => aead,
prf => sha384};
-%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites
+suite_definition(?TLS_PSK_WITH_AES_128_CCM) ->
+ #{key_exchange => psk,
+ cipher => aes_128_ccm,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_PSK_WITH_AES_256_CCM) ->
+ #{key_exchange => psk,
+ cipher => aes_256_ccm,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_DHE_PSK_WITH_AES_128_CCM) ->
+ #{key_exchange => dhe_psk,
+ cipher => aes_128_ccm,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_DHE_PSK_WITH_AES_256_CCM) ->
+ #{key_exchange => dhe_psk,
+ cipher => aes_256_ccm,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_PSK_WITH_AES_128_CCM_8) ->
+ #{key_exchange => psk,
+ cipher => aes_128_ccm_8,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_PSK_WITH_AES_256_CCM_8) ->
+ #{key_exchange => psk,
+ cipher => aes_256_ccm_8,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_PSK_DHE_WITH_AES_128_CCM_8) ->
+ #{key_exchange => dhe_psk,
+ cipher => aes_128_ccm_8,
+ mac => aead,
+ prf => sha256};
+suite_definition(?TLS_PSK_DHE_WITH_AES_256_CCM_8) ->
+ #{key_exchange => dhe_psk,
+ cipher => aes_256_ccm_8,
+ mac => aead,
+ prf => sha256};
+suite_definition(#{key_exchange := psk_dhe,
+ cipher := aes_256_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_DHE_WITH_AES_256_CCM_8;
+
+% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites
suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) ->
#{key_exchange => ecdhe_rsa,
cipher => chacha20_poly1305,
@@ -825,16 +871,15 @@ suite_definition(?TLS_CHACHA20_POLY1305_SHA256) ->
mac => aead,
prf => sha256}.
%% suite_definition(?TLS_AES_128_CCM_SHA256) ->
-%% #{key_exchange => any,
-%% cipher => aes_128_ccm,
-%% mac => aead,
-%% prf => sha256};
+%% #{key_exchange => any,
+%% cipher => aes_128_ccm,
+%% mac => aead,
+%% prf => sha256};
%% suite_definition(?TLS_AES_128_CCM_8_SHA256) ->
-%% #{key_exchange => any,
+%% #{key_exchange => any,
%% cipher => aes_128_ccm_8,
-%% mac => aead,
-%% prf => sha256}.
-
+%% mac => aead,
+%% prf => sha256}.
%%--------------------------------------------------------------------
-spec erl_suite_definition(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite().
@@ -1154,16 +1199,16 @@ suite(#{key_exchange := ecdhe_psk,
mac := null,
prf := sha384}) ->
?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384;
- %% suite(#{key_exchange := ecdhe_psk,
- %% cipher := aes_128_ccm,
- %% mac := null,
- %% prf := sha256}) ->
- %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256;
- %% suite(#{key_exchange := ecdhe_psk,
- %% cipher := aes_256_ccm,
- %% mac := null,
- %% prf := sha256}) ->
- %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_128_ccm_8,
+ mac := null,
+ prf := sha256}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_128_ccm,
+ mac := null,
+ prf := sha256}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256;
%%% SRP Cipher Suites RFC 5054
suite(#{key_exchange := srp_anon,
cipher := '3des_ede_cbc',
@@ -1460,6 +1505,90 @@ suite(#{key_exchange := dhe_rsa,
mac := aead,
prf := sha256}) ->
?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256;
+
+%% RFC 6655 - TLS-1.2 cipher suites
+suite(#{key_exchange := psk,
+ cipher := aes_128_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_WITH_AES_128_CCM;
+suite(#{key_exchange := psk,
+ cipher := aes_256_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_WITH_AES_256_CCM;
+suite(#{key_exchange := dhe_psk,
+ cipher := aes_128_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_PSK_WITH_AES_128_CCM;
+suite(#{key_exchange := dhe_psk,
+ cipher := aes_256_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_PSK_WITH_AES_256_CCM;
+suite(#{key_exchange := rsa,
+ cipher := aes_128_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_RSA_WITH_AES_128_CCM;
+suite(#{key_exchange := rsa,
+ cipher := aes_256_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_RSA_WITH_AES_256_CCM;
+suite(#{key_exchange := dhe_rsa,
+ cipher := aes_128_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_RSA_WITH_AES_128_CCM;
+suite(#{key_exchange := dhe_rsa,
+ cipher := aes_256_ccm,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_RSA_WITH_AES_256_CCM;
+
+suite(#{key_exchange := psk,
+ cipher := aes_128_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_WITH_AES_128_CCM_8;
+suite(#{key_exchange := psk,
+ cipher := aes_256_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_WITH_AES_256_CCM_8;
+suite(#{key_exchange := dhe_psk,
+ cipher := aes_128_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_DHE_WITH_AES_128_CCM_8;
+suite(#{key_exchange := dhe_psk,
+ cipher := aes_256_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_PSK_DHE_WITH_AES_256_CCM_8;
+suite(#{key_exchange := rsa,
+ cipher := aes_128_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_RSA_WITH_AES_128_CCM_8;
+suite(#{key_exchange := rsa,
+ cipher := aes_256_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_RSA_WITH_AES_256_CCM_8;
+suite(#{key_exchange := dhe_rsa,
+ cipher := aes_128_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_RSA_WITH_AES_128_CCM_8;
+suite(#{key_exchange := dhe_rsa,
+ cipher := aes_256_ccm_8,
+ mac := aead,
+ prf := sha256}) ->
+ ?TLS_DHE_RSA_WITH_AES_256_CCM_8;
+
%% TLS 1.3 Cipher Suites RFC8446
suite(#{key_exchange := any,
cipher := aes_128_gcm,
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 6c95a7edf8..3a69c86e47 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -2421,7 +2421,7 @@ decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len),
decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len),
ExtData:Len/binary, Rest/binary>>,
Version, MessageType = hello_retry_request, Acc) ->
- <<?UINT16(Group),Rest/binary>> = ExtData,
+ <<?UINT16(Group)>> = ExtData,
decode_extensions(Rest, Version, MessageType,
Acc#{key_share =>
#key_share_hello_retry_request{
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index 91f1876980..9cc131c3cb 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -471,34 +471,41 @@ initial_security_params(ConnectionEnd) ->
-define(end_additional_data(AAD, Len), << (begin(AAD)end)/binary, ?UINT16(begin(Len)end) >>).
-do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key} = CipherState, AAD0) ->
+do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key, tag_len = TagLen} = CipherState, AAD0) ->
AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)),
Nonce = encrypt_nonce(Type, CipherState),
- {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD),
+ {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen),
{<<Content/binary, CipherTag/binary>>, CipherState};
-do_cipher_aead(Type, Fragment, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0) ->
+do_cipher_aead(Type, Fragment, #cipher_state{key=Key, tag_len = TagLen, nonce = ExplicitNonce} = CipherState, AAD0) ->
AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)),
Nonce = encrypt_nonce(Type, CipherState),
- {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD),
+ {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen),
{<<ExplicitNonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = ExplicitNonce + 1}}.
encrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}) ->
crypto:exor(<<?UINT32(0), Nonce/binary>>, IV);
-encrypt_nonce(?AES_GCM, #cipher_state{iv = IV, nonce = ExplicitNonce}) ->
+encrypt_nonce(Type, #cipher_state{iv = IV, nonce = ExplicitNonce}) when Type == ?AES_GCM;
+ Type == ?AES_CCM;
+ Type == ?AES_CCM_8 ->
<<Salt:4/bytes, _/binary>> = IV,
<<Salt/binary, ExplicitNonce:64/integer>>.
decrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}, _) ->
crypto:exor(<<Nonce:96/unsigned-big-integer>>, IV);
-decrypt_nonce(?AES_GCM, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) ->
- <<Salt/binary, ExplicitNonce/binary>>.
+decrypt_nonce(Type, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) when
+ Type == ?AES_GCM;
+ Type == ?AES_CCM;
+ Type == ?AES_CCM_8 ->
+ <<Salt/binary, ExplicitNonce/binary>>.
-compile({inline, [aead_ciphertext_split/4]}).
aead_ciphertext_split(?CHACHA20_POLY1305, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) ->
CipherLen = byte_size(CipherTextFragment) - Len,
<<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment,
{?end_additional_data(AAD, CipherLen), CipherText, CipherTag};
-aead_ciphertext_split(?AES_GCM, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) ->
+aead_ciphertext_split(Type, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) when Type == ?AES_GCM;
+ Type == ?AES_CCM;
+ Type == ?AES_CCM_8 ->
CipherLen = byte_size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce
<< _:8/bytes, CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment,
{?end_additional_data(AAD, CipherLen), CipherText, CipherTag}.
diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl
index eb718fd20c..6d4d47cedb 100644
--- a/lib/ssl/src/ssl_record.hrl
+++ b/lib/ssl/src/ssl_record.hrl
@@ -96,6 +96,11 @@
-define(AES_CBC, 7).
-define(AES_GCM, 8).
-define(CHACHA20_POLY1305, 9).
+%% Following two are not defined in any RFC but we want to have the
+%% same type of handling internaly, all of these "bulk_cipher_algorithm"
+%% enums are only used internaly anyway.
+-define(AES_CCM, 10).
+-define(AES_CCM_8, 11).
%% CipherType
-define(STREAM, 0).
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index fde73cdef1..a05858221a 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -934,7 +934,7 @@ wait_sh(Type, Event, State) ->
callback_mode() ->
state_functions.
-terminate({shutdown, sender_died, Reason}, _StateName,
+terminate({shutdown, {sender_died, Reason}}, _StateName,
#state{static_env = #static_env{socket = Socket,
transport_cb = Transport}}
= State) ->
@@ -1119,7 +1119,7 @@ handle_info({CloseTag, Socket}, StateName,
end;
handle_info({'EXIT', Sender, Reason}, _,
#state{protocol_specific = #{sender := Sender}} = State) ->
- {stop, {shutdown, sender_died, Reason}, State};
+ {stop, {shutdown, {sender_died, Reason}}, State};
handle_info(Msg, StateName, State) ->
ssl_connection:StateName(info, Msg, State, ?MODULE).
diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl
index 97331e1510..74321a1ae2 100644
--- a/lib/ssl/src/tls_record_1_3.erl
+++ b/lib/ssl/src/tls_record_1_3.erl
@@ -252,7 +252,7 @@ cipher_aead(Fragment, BulkCipherAlgo, Key, Seq, IV, TagLen) ->
AAD = additional_data(erlang:iolist_size(Fragment) + TagLen),
Nonce = nonce(Seq, IV),
{Content, CipherTag} =
- ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD),
+ ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD, TagLen),
<<Content/binary, CipherTag/binary>>.
encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type,
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index fc483b0a94..f7fae16088 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -64,8 +64,9 @@ MODULES = \
ssl_sni_SUITE \
ssl_eqc_SUITE \
ssl_rfc_5869_SUITE \
- make_certs\
- x509_test
+ make_certs \
+ x509_test \
+ inet_crypto_dist
ERL_FILES = $(MODULES:%=%.erl)
diff --git a/lib/ssl/test/inet_crypto_dist.erl b/lib/ssl/test/inet_crypto_dist.erl
new file mode 100644
index 0000000000..5aafaac983
--- /dev/null
+++ b/lib/ssl/test/inet_crypto_dist.erl
@@ -0,0 +1,1323 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% -------------------------------------------------------------------------
+%%
+%% Module for encrypted Erlang protocol - a minimal encrypted
+%% distribution protocol based on only a shared secret
+%% and the crypto application
+%%
+-module(inet_crypto_dist).
+-define(DIST_NAME, inet_crypto).
+-define(DIST_PROTO, crypto).
+-define(DRIVER, inet_tcp).
+-define(FAMILY, inet).
+
+-define(PROTOCOL, inet_crypto_dist_v1).
+-define(DEFAULT_BLOCK_CRYPTO, aes_128_gcm).
+-define(DEFAULT_HASH_ALGORITHM, sha256).
+-define(DEFAULT_REKEY_INTERVAL, 32768).
+
+-export([listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+-export([is_supported/0]).
+
+%% Generalized dist API, for sibling IPv6 module inet6_crypto_dist
+-export([gen_listen/2, gen_accept/2, gen_accept_connection/6,
+ gen_setup/6, gen_close/2, gen_select/2]).
+
+-export([nodelay/0]).
+
+%% Debug
+%%%-compile(export_all).
+-export([dbg/0, test_server/0, test_client/1]).
+
+-include_lib("kernel/include/net_address.hrl").
+-include_lib("kernel/include/dist.hrl").
+-include_lib("kernel/include/dist_util.hrl").
+
+%% Test if crypto has got enough capabilities for this module to run
+%%
+is_supported() ->
+ try {crypto:cipher_info(?DEFAULT_BLOCK_CRYPTO),
+ crypto:hash_info(?DEFAULT_HASH_ALGORITHM)}
+ of
+ {#{block_size := _, iv_length := _, key_length := _},
+ #{size := _}} ->
+ true
+ catch
+ error:undef ->
+ false
+ end.
+
+%% -------------------------------------------------------------------------
+%% Erlang distribution plugin structure explained to myself
+%% -------
+%% These are the processes involved in the distribution:
+%% * net_kernel
+%% * The Acceptor
+%% * The Controller | Handshaker | Ticker
+%% * The DistCtrl process that may be split into:
+%% + The Output controller
+%% + The Input controller
+%% For the regular inet_tcp_dist distribution module, DistCtrl
+%% is not one or two processes, but one port - a gen_tcp socket
+%%
+%% When the VM is started with the argument "-proto_dist inet_crypto"
+%% net_kernel registers the module inet_crypto_dist as distribution
+%% module. net_kernel calls listen/1 to create a listen socket
+%% and then accept/1 with the listen socket as argument to spawn
+%% the Acceptor process, which is linked to net_kernel. Apparently
+%% the listen socket is owned by net_kernel - I wonder if it could
+%% be owned by the Acceptor process instead...
+%%
+%% The Acceptor process calls blocking accept on the listen socket
+%% and when an incoming socket is returned it spawns the DistCtrl
+%% process a linked to the Acceptor. The ownership of the accepted
+%% socket is transferred to the DistCtrl process.
+%% A message is sent to net_kernel to inform it that an incoming
+%% connection has appeared and the Acceptor awaits a reply from net_kernel.
+%%
+%% net_kernel then calls accept_connection/5 to spawn the Controller |
+%% Handshaker | Ticker process that is linked to net_kernel.
+%% The Controller then awaits a message from the Acceptor process.
+%%
+%% When net_kernel has spawned the Controller it replies with a message
+%% to the Acceptor that then calls DistCtrl to changes its links
+%% so DistCtrl ends up linked to the Controller and not to the Acceptor.
+%% The Acceptor then sends a message to the Controller. The Controller
+%% then changes role into the Handshaker creates a #hs_data{} record
+%% and calls dist_util:handshake_other_started/1. After this
+%% the Acceptor goes back into a blocking accept on the listen socket.
+%%
+%% For the regular distribution inet_tcp_dist DistCtrl is a gen_tcp socket
+%% and when it is a process it also acts as a socket. The #hs_data{}
+%% record used by dist_util presents a set of funs that are used
+%% by dist_util to perform the distribution handshake. These funs
+%% make sure to transfer the handshake messages through the DistCtrl
+%% "socket".
+%%
+%% When the handshake is finished a fun for this purpose in #hs_data{}
+%% is called, which tells DistCtrl that it does not need to be prepared
+%% for any more #hs_data{} handshake calls. The DistCtrl process in this
+%% module then spawns the Input controller process that gets ownership
+%% of the connection's gen_tcp socket and changes into {active, N} mode
+%% so now it gets all incoming traffic and delivers that to the VM.
+%% The original DistCtrl process changes role into the Output controller
+%% process and starts asking the VM for outbound messages and transfers
+%% them on the connection socket.
+%%
+%% The Handshaker now changes into the Ticker role, and uses only two
+%% functions in the #hs_data{} record; one to get socket statistics
+%% and one to send a tick. None of these may block for any reason
+%% in particular not for a congested socket since that would destroy
+%% connection supervision.
+%%
+%%
+%% For an connection net_kernel calls setup/5 which spawns the
+%% Controller process as linked to net_kernel. This Controller process
+%% connects to the other node's listen socket and when that is succesful
+%% spawns the DistCtrl process as linked to the controller and transfers
+%% socket ownership to it.
+%%
+%% Then the Controller creates the #hs_data{} record and calls
+%% dist_util:handshake_we_started/1 which changes the process role
+%% into Handshaker.
+%%
+%% When the distribution handshake is finished the procedure is just
+%% as for an incoming connection above.
+%%
+%%
+%% To sum it up.
+%%
+%% There is an Acceptor process that is linked to net_kernel and
+%% informs it when new connections arrive.
+%%
+%% net_kernel spawns Controllers for incoming and for outgoing connections.
+%% these Controllers use the DistCtrl processes to do distribution
+%% handshake and after that becomes Tickers that supervise the connection.
+%%
+%% The Controller | Handshaker | Ticker is linked to net_kernel, and to
+%% DistCtrl, one or both. If any of these connection processes would die
+%% all others should be killed by the links. Therefore none of them may
+%% terminate with reason 'normal'.
+%% -------------------------------------------------------------------------
+
+%% -------------------------------------------------------------------------
+%% select/1 is called by net_kernel to ask if this distribution protocol
+%% is willing to handle Node
+%%
+
+select(Node) ->
+ gen_select(Node, ?DRIVER).
+
+gen_select(Node, Driver) ->
+ case dist_util:split_node(Node) of
+ {node, _, Host} ->
+ case Driver:getaddr(Host) of
+ {ok, _} -> true;
+ _ -> false
+ end;
+ _ ->
+ false
+ end.
+
+%% -------------------------------------------------------------------------
+
+is_node_name(Node) ->
+ dist_util:is_node_name(Node).
+
+%% -------------------------------------------------------------------------
+%% Called by net_kernel to create a listen socket for this
+%% distribution protocol. This listen socket is used by
+%% the Acceptor process.
+%%
+
+listen(Name) ->
+ gen_listen(Name, ?DRIVER).
+
+gen_listen(Name, Driver) ->
+ case inet_tcp_dist:gen_listen(Driver, Name) of
+ {ok, {Socket, Address, Creation}} ->
+ inet:setopts(Socket, [binary, {nodelay, true}]),
+ {ok,
+ {Socket, Address#net_address{protocol = ?DIST_PROTO}, Creation}};
+ Other ->
+ Other
+ end.
+
+%% -------------------------------------------------------------------------
+%% Called by net_kernel to spawn the Acceptor process that awaits
+%% new connection in a blocking accept and informs net_kernel
+%% when a new connection has appeared, and starts the DistCtrl
+%% "socket" process for the connection.
+%%
+
+accept(Listen) ->
+ gen_accept(Listen, ?DRIVER).
+
+gen_accept(Listen, Driver) ->
+ NetKernel = self(),
+ %%
+ %% Spawn Acceptor process
+ %%
+ Config = config(),
+ monitor_dist_proc(
+ spawn_opt(
+ fun () ->
+ accept_loop(Listen, Driver, NetKernel, Config)
+ end,
+ [link, {priority, max}])).
+
+accept_loop(Listen, Driver, NetKernel, Config) ->
+ case Driver:accept(Listen) of
+ {ok, Socket} ->
+ wait_for_code_server(),
+ Timeout = net_kernel:connecttime(),
+ DistCtrl = start_dist_ctrl(Socket, Config, Timeout),
+ %% DistCtrl is a "socket"
+ NetKernel !
+ {accept,
+ self(), DistCtrl, Driver:family(), ?DIST_PROTO},
+ receive
+ {NetKernel, controller, Controller} ->
+ call_dist_ctrl(DistCtrl, {controller, Controller, self()}),
+ Controller ! {self(), controller, Socket};
+ {NetKernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end,
+ accept_loop(Listen, Driver, NetKernel, Config);
+ AcceptError ->
+ exit({accept, AcceptError})
+ end.
+
+wait_for_code_server() ->
+ %% This is an ugly hack. Starting encryption on a connection
+ %% requires the crypto module to be loaded. Loading the crypto
+ %% module triggers its on_load function, which calls
+ %% code:priv_dir/1 to find the directory where its NIF library is.
+ %% However, distribution is started earlier than the code server,
+ %% so the code server is not necessarily started yet, and
+ %% code:priv_dir/1 might fail because of that, if we receive
+ %% an incoming connection on the distribution port early enough.
+ %%
+ %% If the on_load function of a module fails, the module is
+ %% unloaded, and the function call that triggered loading it fails
+ %% with 'undef', which is rather confusing.
+ %%
+ %% So let's avoid that by waiting for the code server to start.
+ %%
+ case whereis(code_server) of
+ undefined ->
+ timer:sleep(10),
+ wait_for_code_server();
+ Pid when is_pid(Pid) ->
+ ok
+ end.
+
+%% -------------------------------------------------------------------------
+%% Called by net_kernel when a new connection has appeared, to spawn
+%% a Controller process that performs the handshake with the new node,
+%% and then becomes the Ticker connection supervisor.
+%% -------------------------------------------------------------------------
+
+accept_connection(Acceptor, DistCtrl, MyNode, Allowed, SetupTime) ->
+ gen_accept_connection(
+ Acceptor, DistCtrl, MyNode, Allowed, SetupTime, ?DRIVER).
+
+gen_accept_connection(
+ Acceptor, DistCtrl, MyNode, Allowed, SetupTime, Driver) ->
+ NetKernel = self(),
+ %%
+ %% Spawn Controller/handshaker/ticker process
+ %%
+ monitor_dist_proc(
+ spawn_opt(
+ fun() ->
+ do_accept(
+ Acceptor, DistCtrl,
+ MyNode, Allowed, SetupTime, Driver, NetKernel)
+ end,
+ [link, {priority, max}])).
+
+do_accept(
+ Acceptor, DistCtrl, MyNode, Allowed, SetupTime, Driver, NetKernel) ->
+ receive
+ {Acceptor, controller, Socket} ->
+ Timer = dist_util:start_timer(SetupTime),
+ HSData =
+ hs_data_common(
+ NetKernel, MyNode, DistCtrl, Timer,
+ Socket, Driver:family()),
+ HSData_1 =
+ HSData#hs_data{
+ this_node = MyNode,
+ this_flags = 0,
+ allowed = Allowed},
+ dist_util:handshake_other_started(trace(HSData_1))
+ end.
+
+%% -------------------------------------------------------------------------
+%% Called by net_kernel to spawn a Controller process that sets up
+%% a new connection to another Erlang node, performs the handshake
+%% with the other it, and then becomes the Ticker process
+%% that supervises the connection.
+%% -------------------------------------------------------------------------
+
+setup(Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ gen_setup(Node, Type, MyNode, LongOrShortNames, SetupTime, ?DRIVER).
+
+gen_setup(Node, Type, MyNode, LongOrShortNames, SetupTime, Driver) ->
+ NetKernel = self(),
+ %%
+ %% Spawn Controller/handshaker/ticker process
+ %%
+ monitor_dist_proc(
+ spawn_opt(
+ setup_fun(
+ Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel),
+ [link, {priority, max}])).
+
+-spec setup_fun(_,_,_,_,_,_,_) -> fun(() -> no_return()).
+setup_fun(
+ Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel) ->
+ fun() ->
+ do_setup(
+ Node, Type, MyNode, LongOrShortNames, SetupTime,
+ Driver, NetKernel)
+ end.
+
+-spec do_setup(_,_,_,_,_,_,_) -> no_return().
+do_setup(
+ Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel) ->
+ {Name, Address} = split_node(Driver, Node, LongOrShortNames),
+ ErlEpmd = net_kernel:epmd_module(),
+ {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver),
+ Timer = trace(dist_util:start_timer(SetupTime)),
+ case ARMod:ARFun(Name, Address, Driver:family()) of
+ {ok, Ip, TcpPort, Version} ->
+ do_setup_connect(
+ Node, Type, MyNode, Timer, Driver, NetKernel,
+ Ip, TcpPort, Version);
+ {ok, Ip} ->
+ case ErlEpmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ do_setup_connect(
+ Node, Type, MyNode, Timer, Driver, NetKernel,
+ Ip, TcpPort, Version);
+ Other ->
+ ?shutdown2(
+ Node,
+ trace(
+ {port_please_failed, ErlEpmd, Name, Ip, Other}))
+ end;
+ Other ->
+ ?shutdown2(
+ Node,
+ trace({getaddr_failed, Driver, Address, Other}))
+ end.
+
+-spec do_setup_connect(_,_,_,_,_,_,_,_,_) -> no_return().
+
+do_setup_connect(
+ Node, Type, MyNode, Timer, Driver, NetKernel,
+ Ip, TcpPort, Version) ->
+ dist_util:reset_timer(Timer),
+ ConnectOpts =
+ trace(
+ connect_options(
+ [binary, {active, false}, {packet, 2}, {nodelay, true}])),
+ case Driver:connect(Ip, TcpPort, ConnectOpts) of
+ {ok, Socket} ->
+ Config = config(),
+ DistCtrl =
+ start_dist_ctrl(Socket, Config, net_kernel:connecttime()),
+ %% DistCtrl is a "socket"
+ HSData =
+ hs_data_common(
+ NetKernel, MyNode, DistCtrl, Timer,
+ Socket, Driver:family()),
+ HSData_1 =
+ HSData#hs_data{
+ other_node = Node,
+ this_flags = 0,
+ other_version = Version,
+ request_type = Type},
+ dist_util:handshake_we_started(trace(HSData_1));
+ ConnectError ->
+ ?shutdown2(Node,
+ trace({connect_failed, Ip, TcpPort, ConnectError}))
+ end.
+
+%% -------------------------------------------------------------------------
+%% close/1 is only called by net_kernel on the socket returned by listen/1.
+
+close(Socket) ->
+ gen_close(Socket, ?DRIVER).
+
+gen_close(Socket, Driver) ->
+ trace(Driver:close(Socket)).
+
+%% -------------------------------------------------------------------------
+
+
+hs_data_common(NetKernel, MyNode, DistCtrl, Timer, Socket, Family) ->
+ %% Field 'socket' below is set to DistCtrl, which makes
+ %% the distribution handshake process (ticker) call
+ %% the funs below with DistCtrl as the S argument.
+ %% So, S =:= DistCtrl below...
+ #hs_data{
+ kernel_pid = NetKernel,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ %%
+ f_send =
+ fun (S, Packet) when S =:= DistCtrl ->
+ call_dist_ctrl(S, {send, Packet})
+ end,
+ f_recv =
+ fun (S, 0, infinity) when S =:= DistCtrl ->
+ case call_dist_ctrl(S, recv) of
+ {ok, Bin} when is_binary(Bin) ->
+ {ok, binary_to_list(Bin)};
+ Error ->
+ Error
+ end
+ end,
+ f_setopts_pre_nodeup =
+ fun (S) when S =:= DistCtrl ->
+ ok
+ end,
+ f_setopts_post_nodeup =
+ fun (S) when S =:= DistCtrl ->
+ ok
+ end,
+ f_getll =
+ fun (S) when S =:= DistCtrl ->
+ {ok, S} %% DistCtrl is the distribution port
+ end,
+ f_address =
+ fun (S, Node) when S =:= DistCtrl ->
+ case call_dist_ctrl(S, peername) of
+ {ok, Address} ->
+ case dist_util:split_node(Node) of
+ {node, _, Host} ->
+ #net_address{
+ address = Address,
+ host = Host,
+ protocol = ?DIST_PROTO,
+ family = Family};
+ _ ->
+ {error, no_node}
+ end
+ end
+ end,
+ f_handshake_complete =
+ fun (S, _Node, DistHandle) when S =:= DistCtrl ->
+ call_dist_ctrl(S, {handshake_complete, DistHandle})
+ end,
+ %%
+ %% mf_tick/1, mf_getstat/1, mf_setopts/2 and mf_getopts/2
+ %% are called by the ticker any time after f_handshake_complete/3
+ %% so they may not block the caller even for congested socket
+ mf_tick =
+ fun (S) when S =:= DistCtrl ->
+ S ! dist_tick
+ end,
+ mf_getstat =
+ fun (S) when S =:= DistCtrl ->
+ case
+ inet:getstat(Socket, [recv_cnt, send_cnt, send_pend])
+ of
+ {ok, Stat} ->
+ split_stat(Stat, 0, 0, 0);
+ Error ->
+ Error
+ end
+ end,
+ mf_setopts =
+ fun (S, Opts) when S =:= DistCtrl ->
+ inet:setopts(Socket, setopts_filter(Opts))
+ end,
+ mf_getopts =
+ fun (S, Opts) when S =:= DistCtrl ->
+ inet:getopts(Socket, Opts)
+ end}.
+
+setopts_filter(Opts) ->
+ [Opt ||
+ Opt <- Opts,
+ case Opt of
+ {K, _} when K =:= active; K =:= deliver; K =:= packet -> false;
+ K when K =:= list; K =:= binary -> false;
+ K when K =:= inet; K =:= inet6 -> false;
+ _ -> true
+ end].
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
+%% ------------------------------------------------------------
+%% Determine if EPMD module supports address resolving. Default
+%% is to use inet_tcp:getaddr/2.
+%% ------------------------------------------------------------
+get_address_resolver(EpmdModule, _Driver) ->
+ case erlang:function_exported(EpmdModule, address_please, 3) of
+ true -> {EpmdModule, address_please};
+ _ -> {erl_epmd, address_please}
+ end.
+
+
+%% If Node is illegal terminate the connection setup!!
+split_node(Driver, Node, LongOrShortNames) ->
+ case dist_util:split_node(Node) of
+ {node, Name, Host} ->
+ check_node(Driver, Node, Name, Host, LongOrShortNames);
+ {host, _} ->
+ error_logger:error_msg(
+ "** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown2(Node, trace({illegal_node_n@me, Node}));
+ _ ->
+ error_logger:error_msg(
+ "** Nodename ~p illegal **~n", [Node]),
+ ?shutdown2(Node, trace({illegal_node_name, Node}))
+ end.
+
+check_node(Driver, Node, Name, Host, LongOrShortNames) ->
+ case string:split(Host, ".", all) of
+ [_] when LongOrShortNames =:= longnames ->
+ case Driver:parse_address(Host) of
+ {ok, _} ->
+ {Name, Host};
+ _ ->
+ error_logger:error_msg(
+ "** System running to use "
+ "fully qualified hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown2(Node, trace({not_longnames, Host}))
+ end;
+ [_, _|_] when LongOrShortNames =:= shortnames ->
+ error_logger:error_msg(
+ "** System NOT running to use "
+ "fully qualified hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown2(Node, trace({not_shortnames, Host}));
+ _ ->
+ {Name, Host}
+ end.
+
+%% -------------------------------------------------------------------------
+
+connect_options(Opts) ->
+ case application:get_env(kernel, inet_dist_connect_options) of
+ {ok, ConnectOpts} ->
+ Opts ++ setopts_filter(ConnectOpts);
+ _ ->
+ Opts
+ end.
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+config() ->
+ case init:get_argument(?DIST_NAME) of
+ error ->
+ error({missing_argument, ?DIST_NAME});
+ {ok, [[String]]} ->
+ {ok, Tokens, _} = erl_scan:string(String ++ "."),
+ case erl_parse:parse_term(Tokens) of
+ {ok, #{secret := Secret} = Config}
+ when is_binary(Secret); is_list(Secret) ->
+ Config;
+ {ok, #{} = Config} ->
+ error({missing_secret, [{?DIST_NAME,Config}]});
+ _ ->
+ error({bad_argument_value, [{?DIST_NAME,String}]})
+ end;
+ {ok, Value} ->
+ error({malformed_argument, [{?DIST_NAME,Value}]})
+ end.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% The DistCtrl process(es).
+%%
+%% At net_kernel handshake_complete spawns off the input controller that
+%% takes over the socket ownership, and itself becomes the output controller
+%%
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% XXX Missing to "productified":
+%%% * Cryptoanalysis by experts
+%%% * Proof of usefulness
+%%% * Unifying exit reasons using a death_row() function
+%%% * Verification (and rejection) of other end's crypto parameters
+%%% * OTP:ification (proc_lib?)
+%%% * An application to belong to (crypto|kernel?)
+%%% * Secret on file (cookie as default?), parameter handling
+%%% * Restart and/or code reload policy
+
+%% Debug client and server
+
+test_config() ->
+ #{secret => <<"Secret Cluster Password 123456">>}.
+
+test_server() ->
+ {ok, Listen} = gen_tcp:listen(0, [{packet, 2}, {active, false}, binary]),
+ {ok, Port} = inet:port(Listen),
+ io:format(?MODULE_STRING":test_client(~w).~n", [Port]),
+ {ok, Socket} = gen_tcp:accept(Listen),
+ test(Socket).
+
+test_client(Port) ->
+ {ok, Socket} =
+ gen_tcp:connect(
+ localhost, Port, [{packet, 2}, {active, false}, binary]),
+ test(Socket).
+
+test(Socket) ->
+ start_dist_ctrl(Socket, test_config(), 10000).
+
+%% -------------------------------------------------------------------------
+
+start_dist_ctrl(Socket, Config, Timeout) ->
+ Protocol = ?PROTOCOL,
+ Controller = self(),
+ Server =
+ monitor_dist_proc(
+ spawn_opt(
+ fun () ->
+ receive
+ {?MODULE, From, start} ->
+ {SendParams, RecvParams} =
+ init(Socket, Config, Protocol),
+ reply(From, self()),
+ handshake(SendParams, 0, RecvParams, 0, Controller)
+ end
+ end,
+ [link,
+ {priority, max},
+ {message_queue_data, off_heap},
+ {fullsweep_after, 0}])),
+ ok = gen_tcp:controlling_process(Socket, Server),
+ call_dist_ctrl(Server, start, Timeout).
+
+
+call_dist_ctrl(Server, Msg) ->
+ call_dist_ctrl(Server, Msg, infinity).
+%%
+call_dist_ctrl(Server, Msg, Timeout) ->
+ Ref = erlang:monitor(process, Server),
+ Server ! {?MODULE, {Ref, self()}, Msg},
+ receive
+ {Ref, Res} ->
+ erlang:demonitor(Ref, [flush]),
+ Res;
+ {'DOWN', Ref, process, Server, Reason} ->
+ exit({?PROTOCOL, Reason})
+ after Timeout ->
+ exit(Server, timeout),
+ receive
+ {'DOWN', Ref, process, Server, _} ->
+ exit({?PROTOCOL, timeout})
+ end
+ end.
+
+reply({Ref, Pid}, Msg) ->
+ Pid ! {Ref, Msg},
+ ok.
+
+%% -------------------------------------------------------------------------
+
+-record(params,
+ {protocol, % Encryption protocol tag
+ socket,
+ dist_handle,
+ hash_algorithm,
+ block_crypto,
+ rekey_interval,
+ iv,
+ key,
+ tag_len}).
+
+-define(TCP_ACTIVE, 64).
+-define(CHUNK_SIZE, (65536 - 512)).
+%% The start chunk starts with zeros, so it seems logical to not have
+%% a chunk type with value 0
+-define(HANDSHAKE_CHUNK, 1).
+-define(DATA_CHUNK, 2).
+-define(TICK_CHUNK, 3).
+-define(REKEY_CHUNK, 4).
+
+%% -------------------------------------------------------------------------
+%% Crypto strategy
+%% -------
+%% The crypto strategy is as simple as possible to get an encrypted
+%% connection as benchmark reference. It is geared around AEAD
+%% ciphers in particular AES-GCM.
+%%
+%% The init message and the start message must fit in the TCP buffers
+%% since both sides start with sending the init message, waits
+%% for the other end's init message, sends the start message
+%% and waits for the other end's start message. So if the send
+%% blocks we have a deadlock.
+%%
+%% The init message is unencrypted and contains the block cipher and hash
+%% algorithms the sender will use, the IV and a key salt. Both sides'
+%% key salt is used with the mutual secret as input to the hash algorithm
+%% to create different encryption/decryption keys for both directions.
+%%
+%% The start message is the first encrypted message and contains just
+%% encrypted zeros the width of the key, with the header of the init
+%% message as AAD data. Successfully decrypting this message
+%% verifies that we have an encrypted channel.
+%%
+%% Subsequent encrypted messages has the sequence number and the length
+%% of the message as AAD data. These messages has got a message type
+%% differentiating data from ticks. Ticks have a random size in an
+%% attempt to make them less obvious to spot.
+%%
+%% The only reaction to errors is to crash noisily wich will bring
+%% down the connection and hopefully produce something useful
+%% in the local log, but all the other end sees is a closed connection.
+%% -------------------------------------------------------------------------
+
+init(Socket, Config, Protocol) ->
+ Secret = maps:get(secret, Config),
+ HashAlgorithm =
+ maps:get(hash_algorithm, Config, ?DEFAULT_HASH_ALGORITHM),
+ BlockCrypto =
+ maps:get(block_crypto, Config, ?DEFAULT_BLOCK_CRYPTO),
+ RekeyInterval =
+ maps:get(rekey_interval, Config, ?DEFAULT_REKEY_INTERVAL),
+ %%
+ SendParams =
+ init_params(
+ Socket, Protocol, HashAlgorithm, BlockCrypto, RekeyInterval),
+ send_init(SendParams, Secret).
+
+send_init(
+ #params{
+ protocol = Protocol,
+ socket = Socket,
+ block_crypto = BlockCrypto,
+ iv = IVLen,
+ key = KeyLen,
+ hash_algorithm = HashAlgorithm} = SendParams,
+ Secret) ->
+ %%
+ ProtocolString = atom_to_binary(Protocol, utf8),
+ BlockCryptoString = atom_to_binary(BlockCrypto, utf8),
+ HashAlgorithmString = atom_to_binary(HashAlgorithm, utf8),
+ SendHeader =
+ <<ProtocolString/binary, 0,
+ HashAlgorithmString/binary, 0,
+ BlockCryptoString/binary, 0>>,
+ <<IV:IVLen/binary, KeySalt:KeyLen/binary>> = IV_KeySalt =
+ crypto:strong_rand_bytes(IVLen + KeyLen),
+ InitPacket = [SendHeader, IV_KeySalt],
+ ok = gen_tcp:send(Socket, InitPacket),
+ recv_init(SendParams#params{iv = IV, key = KeySalt}, Secret, SendHeader).
+
+recv_init(
+ #params{
+ socket = Socket,
+ hash_algorithm = SendHashAlgorithm,
+ key = SendKeySalt} = SendParams, Secret, SendHeader) ->
+ %%
+ {ok, InitPacket} = gen_tcp:recv(Socket, 0),
+ [ProtocolString, Rest_1] = binary:split(InitPacket, <<0>>),
+ Protocol = binary_to_existing_atom(ProtocolString, utf8),
+ case Protocol of
+ ?PROTOCOL ->
+ [HashAlgorithmString, Rest_2] = binary:split(Rest_1, <<0>>),
+ HashAlgorithm = binary_to_existing_atom(HashAlgorithmString, utf8),
+ [BlockCryptoString, Rest_3] = binary:split(Rest_2, <<0>>),
+ BlockCrypto = binary_to_existing_atom(BlockCryptoString, utf8),
+ #params{
+ hash_algorithm = RecvHashAlgorithm,
+ iv = RecvIVLen,
+ key = RecvKeyLen} = RecvParams =
+ init_params(
+ Socket, Protocol, HashAlgorithm, BlockCrypto, undefined),
+ <<RecvIV:RecvIVLen/binary,
+ RecvKeySalt:RecvKeyLen/binary>> = Rest_3,
+ SendKey =
+ hash_key(SendHashAlgorithm, SendKeySalt, [RecvKeySalt, Secret]),
+ RecvKey =
+ hash_key(RecvHashAlgorithm, RecvKeySalt, [SendKeySalt, Secret]),
+ SendParams_1 = SendParams#params{key = SendKey},
+ RecvParams_1 = RecvParams#params{iv = RecvIV, key = RecvKey},
+ RecvHeaderLen = byte_size(InitPacket) - RecvIVLen - RecvKeyLen,
+ <<RecvHeader:RecvHeaderLen/binary, _/binary>> = InitPacket,
+ send_start(SendParams_1, SendHeader),
+ RecvRekeyInterval = recv_start(RecvParams_1, RecvHeader),
+ {SendParams_1,
+ RecvParams_1#params{rekey_interval = RecvRekeyInterval}}
+ end.
+
+send_start(
+ #params{
+ socket = Socket,
+ block_crypto = BlockCrypto,
+ rekey_interval= RekeyInterval,
+ iv = IV,
+ key = Key,
+ tag_len = TagLen}, AAD) ->
+ %%
+ KeyLen = byte_size(Key),
+ Zeros = binary:copy(<<0>>, KeyLen),
+ {Ciphertext, CipherTag} =
+ crypto:block_encrypt(
+ crypto_cipher_name(BlockCrypto),
+ Key, IV, {AAD, [Zeros, <<RekeyInterval:32>>], TagLen}),
+ ok = gen_tcp:send(Socket, [Ciphertext, CipherTag]).
+
+recv_start(
+ #params{
+ socket = Socket,
+ block_crypto = BlockCrypto,
+ iv = IV,
+ key = Key,
+ tag_len = TagLen}, AAD) ->
+ {ok, Packet} = gen_tcp:recv(Socket, 0),
+ KeyLen = byte_size(Key),
+ PacketLen = KeyLen + 4,
+ <<Ciphertext:PacketLen/binary, CipherTag:TagLen/binary>> = Packet,
+ Zeros = binary:copy(<<0>>, KeyLen),
+ case
+ crypto:block_decrypt(
+ crypto_cipher_name(BlockCrypto),
+ Key, IV, {AAD, Ciphertext, CipherTag})
+ of
+ <<Zeros:KeyLen/binary, RekeyInterval:32>>
+ when 1 =< RekeyInterval ->
+ RekeyInterval;
+ _ ->
+ error(decrypt_error)
+ end.
+
+init_params(Socket, Protocol, HashAlgorithm, BlockCrypto, RekeyInterval) ->
+ #{block_size := 1,
+ iv_length := IVLen,
+ key_length := KeyLen} = crypto:cipher_info(BlockCrypto),
+ case crypto:hash_info(HashAlgorithm) of
+ #{size := HashSize} when HashSize >= KeyLen ->
+ #params{
+ socket = Socket,
+ protocol = Protocol,
+ hash_algorithm = HashAlgorithm,
+ block_crypto = BlockCrypto,
+ rekey_interval = RekeyInterval,
+ iv = IVLen,
+ key = KeyLen,
+ tag_len = 16}
+ end.
+
+crypto_cipher_name(BlockCrypto) ->
+ case BlockCrypto of
+ aes_128_gcm -> aes_gcm;
+ aes_192_gcm -> aes_gcm;
+ aes_256_gcm -> aes_gcm
+ end.
+
+hash_key(HashAlgorithm, KeySalt, OtherSalt) ->
+ KeyLen = byte_size(KeySalt),
+ <<Key:KeyLen/binary, _/binary>> =
+ crypto:hash(HashAlgorithm, [KeySalt, OtherSalt]),
+ Key.
+
+%% -------------------------------------------------------------------------
+%% net_kernel distribution handshake in progress
+%%
+
+handshake(
+ SendParams, SendSeq,
+ #params{socket = Socket} = RecvParams, RecvSeq, Controller) ->
+ receive
+ {?MODULE, From, {controller, Controller_1, Parent}} ->
+ Result = link(Controller_1),
+ true = unlink(Parent),
+ reply(From, Result),
+ handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller_1);
+ {?MODULE, From, {handshake_complete, DistHandle}} ->
+ reply(From, ok),
+ InputHandler =
+ monitor_dist_proc(
+ spawn_opt(
+ fun () ->
+ link(Controller),
+ receive
+ DistHandle ->
+ ok =
+ inet:setopts(
+ Socket,
+ [{active, ?TCP_ACTIVE},
+ nodelay()]),
+ input_handler(
+ RecvParams#params{
+ dist_handle = DistHandle},
+ RecvSeq, empty_q(), infinity)
+ end
+ end,
+ [link,
+ {priority, normal},
+ {message_queue_data, off_heap},
+ {fullsweep_after, 0}])),
+ _ = monitor(process, InputHandler), % For the benchmark test
+ ok = gen_tcp:controlling_process(Socket, InputHandler),
+ ok = erlang:dist_ctrl_input_handler(DistHandle, InputHandler),
+ InputHandler ! DistHandle,
+ process_flag(priority, normal),
+ erlang:dist_ctrl_get_data_notification(DistHandle),
+ crypto:rand_seed_alg(crypto_cache),
+ output_handler(
+ SendParams#params{dist_handle = DistHandle}, SendSeq);
+ %%
+ {?MODULE, From, {send, Data}} ->
+ {SendParams_1, SendSeq_1} =
+ encrypt_and_send_chunk(
+ SendParams, SendSeq, [?HANDSHAKE_CHUNK, Data]),
+ reply(From, ok),
+ handshake(
+ SendParams_1, SendSeq_1, RecvParams, RecvSeq, Controller);
+ {?MODULE, From, recv} ->
+ {RecvParams_1, RecvSeq_1, Reply} =
+ recv_and_decrypt_chunk(RecvParams, RecvSeq),
+ reply(From, Reply),
+ handshake(
+ SendParams, SendSeq, RecvParams_1, RecvSeq_1, Controller);
+ {?MODULE, From, peername} ->
+ reply(From, inet:peername(Socket)),
+ handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller);
+ %%
+ _Alien ->
+ handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller)
+ end.
+
+recv_and_decrypt_chunk(#params{socket = Socket} = RecvParams, RecvSeq) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok, Chunk} ->
+ case decrypt_chunk(RecvParams, RecvSeq, Chunk) of
+ <<?HANDSHAKE_CHUNK, Cleartext/binary>> ->
+ {RecvParams, RecvSeq + 1, {ok, Cleartext}};
+ #params{} = RecvParams_1 ->
+ recv_and_decrypt_chunk(RecvParams_1, 0);
+ _ ->
+ error(decrypt_error)
+ end;
+ Error ->
+ {RecvParams, RecvSeq, Error}
+ end.
+
+%% -------------------------------------------------------------------------
+%% Output handler process
+%%
+%% The game here is to flush all dist_data and dist_tick messages,
+%% prioritize dist_data over dist_tick, and to not use selective receive
+
+output_handler(Params, Seq) ->
+ receive
+ Msg ->
+ case Msg of
+ dist_data ->
+ output_handler_data(Params, Seq);
+ dist_tick ->
+ output_handler_tick(Params, Seq);
+ _Other ->
+ %% Ignore
+ output_handler(Params, Seq)
+ end
+ end.
+
+output_handler_data(Params, Seq) ->
+ receive
+ Msg ->
+ case Msg of
+ dist_data ->
+ output_handler_data(Params, Seq);
+ dist_tick ->
+ output_handler_data(Params, Seq);
+ _Other ->
+ %% Ignore
+ output_handler_data(Params, Seq)
+ end
+ after 0 ->
+ DistHandle = Params#params.dist_handle,
+ Q = get_data(DistHandle, empty_q()),
+ {Params_1, Seq_1} = output_handler_send(Params, Seq, Q, true),
+ erlang:dist_ctrl_get_data_notification(DistHandle),
+ output_handler(Params_1, Seq_1)
+ end.
+
+output_handler_tick(Params, Seq) ->
+ receive
+ Msg ->
+ case Msg of
+ dist_data ->
+ output_handler_data(Params, Seq);
+ dist_tick ->
+ output_handler_tick(Params, Seq);
+ _Other ->
+ %% Ignore
+ output_handler_tick(Params, Seq)
+ end
+ after 0 ->
+ TickSize = 8 + rand:uniform(56),
+ TickData = binary:copy(<<0>>, TickSize),
+ {Params_1, Seq_1} =
+ encrypt_and_send_chunk(Params, Seq, [?TICK_CHUNK, TickData]),
+ output_handler(Params_1, Seq_1)
+ end.
+
+output_handler_send(
+ #params{dist_handle = DistHandle} = Params, Seq, {_, Size, _} = Q, Retry) ->
+ %%
+ if
+ ?CHUNK_SIZE < Size ->
+ {Cleartext, Q_1} = deq_iovec(?CHUNK_SIZE, Q),
+ {Params_1, Seq_1} =
+ encrypt_and_send_chunk(Params, Seq, [?DATA_CHUNK, Cleartext]),
+ output_handler_send(Params_1, Seq_1, Q_1, Retry);
+ Retry ->
+ Q_1 = get_data(DistHandle, Q),
+ output_handler_send(Params, Seq, Q_1, false);
+ true ->
+ {Cleartext, _} = deq_iovec(Size, Q),
+ encrypt_and_send_chunk(Params, Seq, [?DATA_CHUNK, Cleartext])
+ end.
+
+%% -------------------------------------------------------------------------
+%% Input handler process
+%%
+%% Here is T 0 or infinity to steer if we should try to receive
+%% more data or not; start with infinity, and when we get some
+%% data try with 0 to see if more is waiting
+
+input_handler(#params{socket = Socket} = Params, Seq, Q, T) ->
+ receive
+ Msg ->
+ case Msg of
+ {tcp_passive, Socket} ->
+ ok = inet:setopts(Socket, [{active, ?TCP_ACTIVE}]),
+ Q_1 =
+ case T of
+ 0 ->
+ deliver_data(Params#params.dist_handle, Q);
+ infinity ->
+ Q
+ end,
+ input_handler(Params, Seq, Q_1, infinity);
+ {tcp, Socket, Chunk} ->
+ input_chunk(Params, Seq, Q, Chunk);
+ {tcp_closed, Socket} ->
+ error(connection_closed);
+ _Other ->
+ %% Ignore...
+ input_handler(Params, Seq, Q, T)
+ end
+ after T ->
+ Q_1 = deliver_data(Params#params.dist_handle, Q),
+ input_handler(Params, Seq, Q_1, infinity)
+ end.
+
+input_chunk(Params, Seq, Q, Chunk) ->
+ case decrypt_chunk(Params, Seq, Chunk) of
+ <<?DATA_CHUNK, Cleartext/binary>> ->
+ input_handler(Params, Seq + 1, enq_binary(Cleartext, Q), 0);
+ <<?TICK_CHUNK, _/binary>> ->
+ input_handler(Params, Seq + 1, Q, 0);
+ #params{} = Params_1 ->
+ input_handler(Params_1, 0, Q, 0);
+ _ ->
+ error(decrypt_error)
+ end.
+
+%% -------------------------------------------------------------------------
+%% erlang:dist_ctrl_* helpers
+
+%% Get data for sending from the VM and place it in a queue
+%%
+get_data(DistHandle, {Front, Size, Rear}) ->
+ get_data(DistHandle, Front, Size, Rear).
+%%
+get_data(DistHandle, Front, Size, Rear) ->
+ case erlang:dist_ctrl_get_data(DistHandle) of
+ none ->
+ {Front, Size, Rear};
+ Bin when is_binary(Bin) ->
+ Len = byte_size(Bin),
+ get_data(
+ DistHandle, Front, Size + 4 + Len,
+ [Bin, <<Len:32>>|Rear]);
+ [Bin1, Bin2] ->
+ Len = byte_size(Bin1) + byte_size(Bin2),
+ get_data(
+ DistHandle, Front, Size + 4 + Len,
+ [Bin2, Bin1, <<Len:32>>|Rear]);
+ Iovec ->
+ Len = iolist_size(Iovec),
+ get_data(
+ DistHandle, Front, Size + 4 + Len,
+ lists:reverse(Iovec, [<<Len:32>>|Rear]))
+ end.
+
+%% De-packet and deliver received data to the VM from a queue
+%%
+deliver_data(DistHandle, Q) ->
+ case Q of
+ {[], Size, []} ->
+ Size = 0, % Assert
+ Q;
+ {[], Size, Rear} ->
+ [Bin|Front] = lists:reverse(Rear),
+ deliver_data(DistHandle, Front, Size, [], Bin);
+ {[Bin|Front], Size, Rear} ->
+ deliver_data(DistHandle, Front, Size, Rear, Bin)
+ end.
+%%
+deliver_data(DistHandle, Front, Size, Rear, Bin) ->
+ case Bin of
+ <<DataSizeA:32, DataA:DataSizeA/binary,
+ DataSizeB:32, DataB:DataSizeB/binary, Rest/binary>> ->
+ erlang:dist_ctrl_put_data(DistHandle, DataA),
+ erlang:dist_ctrl_put_data(DistHandle, DataB),
+ deliver_data(
+ DistHandle,
+ Front, Size - (4 + DataSizeA + 4 + DataSizeB), Rear,
+ Rest);
+ <<DataSize:32, Data:DataSize/binary, Rest/binary>> ->
+ erlang:dist_ctrl_put_data(DistHandle, Data),
+ deliver_data(DistHandle, Front, Size - (4 + DataSize), Rear, Rest);
+ <<DataSize:32, FirstData/binary>> ->
+ TotalSize = 4 + DataSize,
+ if
+ TotalSize =< Size ->
+ BinSize = byte_size(Bin),
+ {MoreData, Q} =
+ deq_iovec(
+ TotalSize - BinSize,
+ Front, Size - BinSize, Rear),
+ erlang:dist_ctrl_put_data(DistHandle, [FirstData|MoreData]),
+ deliver_data(DistHandle, Q);
+ true -> % Incomplete data
+ {[Bin|Front], Size, Rear}
+ end;
+ <<_/binary>> ->
+ BinSize = byte_size(Bin),
+ if
+ 4 =< Size -> % Fragmented header - extract a header bin
+ {RestHeader, {Front_1, _Size_1, Rear_1}} =
+ deq_iovec(4 - BinSize, Front, Size - BinSize, Rear),
+ Header = iolist_to_binary([Bin|RestHeader]),
+ deliver_data(DistHandle, Front_1, Size, Rear_1, Header);
+ true -> % Incomplete header
+ {[Bin|Front], Size, Rear}
+ end
+ end.
+
+%% -------------------------------------------------------------------------
+%% Encryption and decryption helpers
+
+encrypt_and_send_chunk(
+ #params{
+ socket = Socket, rekey_interval = Seq,
+ key = Key, iv = IV, hash_algorithm = HashAlgorithm} = Params,
+ Seq, Cleartext) ->
+ %%
+ KeyLen = byte_size(Key),
+ IVLen = byte_size(IV),
+ Chunk = <<IV_1:IVLen/binary, KeySalt:KeyLen/binary>> =
+ crypto:strong_rand_bytes(IVLen + KeyLen),
+ ok = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, [?REKEY_CHUNK, Chunk])),
+ Key_1 = hash_key(HashAlgorithm, Key, KeySalt),
+ Params_1 = Params#params{key = Key_1, iv = IV_1},
+ ok = gen_tcp:send(Socket, encrypt_chunk(Params_1, 0, Cleartext)),
+ {Params_1, 1};
+encrypt_and_send_chunk(#params{socket = Socket} = Params, Seq, Cleartext) ->
+ ok = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, Cleartext)),
+ {Params, Seq + 1}.
+
+encrypt_chunk(
+ #params{
+ block_crypto = BlockCrypto,
+ iv = IV, key = Key, tag_len = TagLen}, Seq, Cleartext) ->
+ %%
+ ChunkLen = iolist_size(Cleartext) + TagLen,
+ AAD = <<Seq:32, ChunkLen:32>>,
+ {Ciphertext, CipherTag} =
+ crypto:block_encrypt(
+ crypto_cipher_name(BlockCrypto), Key, IV, {AAD, Cleartext, TagLen}),
+ Chunk = [Ciphertext,CipherTag],
+ Chunk.
+
+decrypt_chunk(
+ #params{
+ block_crypto = BlockCrypto,
+ iv = IV, key = Key, tag_len = TagLen} = Params, Seq, Chunk) ->
+ %%
+ ChunkLen = byte_size(Chunk),
+ true = TagLen =< ChunkLen, % Assert
+ AAD = <<Seq:32, ChunkLen:32>>,
+ CiphertextLen = ChunkLen - TagLen,
+ <<Ciphertext:CiphertextLen/binary, CipherTag:TagLen/binary>> = Chunk,
+ block_decrypt(
+ Params, Seq, crypto_cipher_name(BlockCrypto),
+ Key, IV, {AAD, Ciphertext, CipherTag}).
+
+block_decrypt(
+ #params{rekey_interval = Seq} = Params, Seq, CipherName, Key, IV, Data) ->
+ %%
+ KeyLen = byte_size(Key),
+ IVLen = byte_size(IV),
+ case crypto:block_decrypt(CipherName, Key, IV, Data) of
+ <<?REKEY_CHUNK, IV_1:IVLen/binary, KeySalt:KeyLen/binary>> ->
+ Key_1 = hash_key(Params#params.hash_algorithm, Key, KeySalt),
+ Params#params{iv = IV_1, key = Key_1};
+ _ ->
+ error(decrypt_error)
+ end;
+block_decrypt(_Params, _Seq, CipherName, Key, IV, Data) ->
+ crypto:block_decrypt(CipherName, Key, IV, Data).
+
+%% -------------------------------------------------------------------------
+%% Queue of binaries i.e an iovec queue
+
+empty_q() ->
+ {[], 0, []}.
+
+enq_binary(Bin, {Front, Size, Rear}) ->
+ {Front, Size + byte_size(Bin), [Bin|Rear]}.
+
+deq_iovec(GetSize, {Front, Size, Rear}) when GetSize =< Size ->
+ deq_iovec(GetSize, Front, Size, Rear, []).
+%%
+deq_iovec(GetSize, Front, Size, Rear) ->
+ deq_iovec(GetSize, Front, Size, Rear, []).
+%%
+deq_iovec(GetSize, [], Size, Rear, Acc) ->
+ deq_iovec(GetSize, lists:reverse(Rear), Size, [], Acc);
+deq_iovec(GetSize, [Bin|Front], Size, Rear, Acc) ->
+ BinSize = byte_size(Bin),
+ if
+ BinSize < GetSize ->
+ deq_iovec(
+ GetSize - BinSize, Front, Size - BinSize, Rear, [Bin|Acc]);
+ GetSize < BinSize ->
+ {Bin1,Bin2} = erlang:split_binary(Bin, GetSize),
+ {lists:reverse(Acc, [Bin1]), {[Bin2|Front], Size - GetSize, Rear}};
+ true ->
+ {lists:reverse(Acc, [Bin]), {Front, Size - BinSize, Rear}}
+ end.
+
+%% -------------------------------------------------------------------------
+
+%% Trace point
+trace(Term) -> Term.
+
+%% Keep an eye on this Pid (debug)
+monitor_dist_proc(Pid) ->
+%%% spawn(
+%%% fun () ->
+%%% MRef = erlang:monitor(process, Pid),
+%%% receive
+%%% {'DOWN', MRef, _, _, normal} ->
+%%% error_logger:error_report(
+%%% [dist_proc_died,
+%%% {reason, normal},
+%%% {pid, Pid}]);
+%%% {'DOWN', MRef, _, _, Reason} ->
+%%% error_logger:info_report(
+%%% [dist_proc_died,
+%%% {reason, Reason},
+%%% {pid, Pid}])
+%%% end
+%%% end),
+ Pid.
+
+dbg() ->
+ dbg:stop(),
+ dbg:tracer(),
+ dbg:p(all, c),
+ dbg:tpl(?MODULE, cx),
+ dbg:tpl(erlang, dist_ctrl_get_data_notification, cx),
+ dbg:tpl(erlang, dist_ctrl_get_data, cx),
+ dbg:tpl(erlang, dist_ctrl_put_data, cx),
+ ok.
diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec
index 24272327c3..15587abecd 100644
--- a/lib/ssl/test/ssl.spec
+++ b/lib/ssl/test/ssl.spec
@@ -6,5 +6,7 @@
{skip_groups,dir,ssl_bench_SUITE,payload,"Benchmarks run separately"}.
{skip_groups,dir,ssl_bench_SUITE,pem_cache,"Benchmarks run separately"}.
{skip_groups,dir,ssl_dist_bench_SUITE,setup,"Benchmarks run separately"}.
+{skip_groups,dir,ssl_dist_bench_SUITE,roundtrip,"Benchmarks run separately"}.
{skip_groups,dir,ssl_dist_bench_SUITE,throughput,"Benchmarks run separately"}.
+{skip_groups,dir,ssl_dist_bench_SUITE,sched_utilization,"Benchmarks run separately"}.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 6c536816aa..03ee97de5d 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -76,11 +76,9 @@ groups() ->
{'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]},
{api,[], api_tests()},
{api_tls,[], api_tests_tls()},
- {tls_ciphers,[], tls_cipher_tests()},
{session, [], session_tests()},
{renegotiate, [], renegotiate_tests()},
{ciphers, [], cipher_tests()},
- {ciphers_ec, [], cipher_tests_ec()},
{error_handling_tests, [], error_handling_tests()},
{error_handling_tests_tls, [], error_handling_tests_tls()}
].
@@ -88,14 +86,12 @@ groups() ->
tls_versions_groups ()->
[
{group, api_tls},
- {group, tls_ciphers},
{group, error_handling_tests_tls}].
all_versions_groups ()->
[{group, api},
{group, renegotiate},
{group, ciphers},
- {group, ciphers_ec},
{group, error_handling_tests}].
@@ -211,38 +207,11 @@ renegotiate_tests() ->
renegotiate_dos_mitigate_passive,
renegotiate_dos_mitigate_absolute].
-tls_cipher_tests() ->
- [rc4_rsa_cipher_suites,
- rc4_ecdh_rsa_cipher_suites,
- rc4_ecdsa_cipher_suites].
-
cipher_tests() ->
[old_cipher_suites,
- cipher_suites_mix,
- %%ciphers_rsa_signed_certs,
- %%ciphers_rsa_signed_certs_openssl_names,
- %%ciphers_dsa_signed_certs,
- %%ciphers_dsa_signed_certs_openssl_names,
- chacha_rsa_cipher_suites,
- chacha_ecdsa_cipher_suites,
- %%anonymous_cipher_suites,
- %%psk_cipher_suites,
- %%psk_with_hint_cipher_suites,
- %%psk_anon_cipher_suites,
- %%psk_anon_with_hint_cipher_suites,
- %%srp_cipher_suites,
- %%srp_anon_cipher_suites,
- %%srp_dsa_cipher_suites,
- %%des_rsa_cipher_suites,
- %%des_ecdh_rsa_cipher_suites,
+ cipher_suites_mix,
default_reject_anonymous].
-cipher_tests_ec() ->
- [ciphers_ecdsa_signed_certs,
- ciphers_ecdsa_signed_certs_openssl_names,
- ciphers_ecdh_rsa_signed_certs,
- ciphers_ecdh_rsa_signed_certs_openssl_names].
-
error_handling_tests()->
[close_transport_accept,
recv_active,
@@ -410,26 +379,7 @@ init_per_testcase(TestCase, Config) when TestCase == client_renegotiate;
ct:timetrap({seconds, ?SEC_RENEGOTIATION_TIMEOUT + 5}),
Config;
-init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
- TestCase == psk_with_hint_cipher_suites;
- TestCase == ciphers_rsa_signed_certs;
- TestCase == ciphers_rsa_signed_certs_openssl_names;
- TestCase == ciphers_ecdh_rsa_signed_certs_openssl_names;
- TestCase == ciphers_ecdh_rsa_signed_certs;
- TestCase == ciphers_dsa_signed_certs;
- TestCase == ciphers_dsa_signed_certs_openssl_names;
- TestCase == anonymous_cipher_suites;
- TestCase == ciphers_ecdsa_signed_certs;
- TestCase == ciphers_ecdsa_signed_certs_openssl_names;
- TestCase == anonymous_cipher_suites;
- TestCase == psk_anon_cipher_suites;
- TestCase == psk_anon_with_hint_cipher_suites;
- TestCase == srp_cipher_suites;
- TestCase == srp_anon_cipher_suites;
- TestCase == srp_dsa_cipher_suites;
- TestCase == des_rsa_cipher_suites;
- TestCase == des_ecdh_rsa_cipher_suites;
- TestCase == versions_option;
+init_per_testcase(TestCase, Config) when TestCase == versions_option;
TestCase == tls_tcp_connect_big ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
ct:timetrap({seconds, 60}),
@@ -2709,144 +2659,6 @@ tls_shutdown_error(Config) when is_list(Config) ->
ok = ssl:close(Listen),
{error, closed} = ssl:shutdown(Listen, read_write).
-%%-------------------------------------------------------------------
-ciphers_rsa_signed_certs() ->
- [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_rsa_signed_certs(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:rsa_suites(crypto),
- run_suites(Ciphers, Config, rsa).
-%%-------------------------------------------------------------------
-ciphers_rsa_signed_certs_openssl_names() ->
- [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:openssl_rsa_suites(),
- run_suites(Ciphers, Config, rsa).
-
-%%-------------------------------------------------------------------
-ciphers_dsa_signed_certs() ->
- [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_dsa_signed_certs(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:dsa_suites(NVersion),
- run_suites(Ciphers, Config, dsa).
-%%-------------------------------------------------------------------
-ciphers_dsa_signed_certs_openssl_names() ->
- [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:openssl_dsa_suites(),
- run_suites(Ciphers, Config, dsa).
-
-%%-------------------------------------------------------------------
-chacha_rsa_cipher_suites()->
- [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}].
-chacha_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = [S || {KeyEx,_,_} = S <- ssl_test_lib:chacha_suites(NVersion),
- KeyEx == ecdhe_rsa, KeyEx == dhe_rsa],
- run_suites(Ciphers, Config, chacha_ecdsa).
-
-%%-------------------------------------------------------------------
-chacha_ecdsa_cipher_suites()->
- [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}].
-chacha_ecdsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:chacha_suites(NVersion)],
- run_suites(Ciphers, Config, chacha_rsa).
-%%-----------------------------------------------------------------
-anonymous_cipher_suites()->
- [{doc,"Test the anonymous ciphersuites"}].
-anonymous_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:ecdh_dh_anonymous_suites(NVersion),
- run_suites(Ciphers, Config, anonymous).
-%%-------------------------------------------------------------------
-psk_cipher_suites() ->
- [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
-psk_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Config, psk).
-%%-------------------------------------------------------------------
-psk_with_hint_cipher_suites()->
- [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
-psk_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Config, psk_with_hint).
-%%-------------------------------------------------------------------
-psk_anon_cipher_suites() ->
- [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
-psk_anon_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Config, psk_anon).
-%%-------------------------------------------------------------------
-psk_anon_with_hint_cipher_suites()->
- [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
-psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Config, psk_anon_with_hint).
-%%-------------------------------------------------------------------
-srp_cipher_suites()->
- [{doc, "Test the SRP ciphersuites"}].
-srp_cipher_suites(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:srp_suites(),
- run_suites(Ciphers, Config, srp).
-%%-------------------------------------------------------------------
-srp_anon_cipher_suites()->
- [{doc, "Test the anonymous SRP ciphersuites"}].
-srp_anon_cipher_suites(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:srp_anon_suites(),
- run_suites(Ciphers, Config, srp_anon).
-%%-------------------------------------------------------------------
-srp_dsa_cipher_suites()->
- [{doc, "Test the SRP DSA ciphersuites"}].
-srp_dsa_cipher_suites(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:srp_dss_suites(),
- run_suites(Ciphers, Config, srp_dsa).
-%%-------------------------------------------------------------------
-rc4_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
-rc4_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
- run_suites(Ciphers, Config, rc4_rsa).
-%-------------------------------------------------------------------
-rc4_ecdh_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
-rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = [S || {ecdh_rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
- run_suites(Ciphers, Config, rc4_ecdh_rsa).
-
-%%-------------------------------------------------------------------
-rc4_ecdsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
-rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
- run_suites(Ciphers, Config, rc4_ecdsa).
-
-%%-------------------------------------------------------------------
-des_rsa_cipher_suites()->
- [{doc, "Test the des_rsa ciphersuites"}].
-des_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)],
- run_suites(Ciphers, Config, des_rsa).
-%-------------------------------------------------------------------
-des_ecdh_rsa_cipher_suites()->
- [{doc, "Test ECDH rsa signed ciphersuites"}].
-des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = [S || {dhe_rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)],
- run_suites(Ciphers, Config, des_dhe_rsa).
-
%%--------------------------------------------------------------------
default_reject_anonymous()->
[{doc,"Test that by default anonymous cipher suites are rejected "}].
@@ -2873,36 +2685,6 @@ default_reject_anonymous(Config) when is_list(Config) ->
ssl_test_lib:check_server_alert(Server, Client, insufficient_security).
%%--------------------------------------------------------------------
-ciphers_ecdsa_signed_certs() ->
- [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:ecdsa_suites(NVersion),
- run_suites(Ciphers, Config, ecdsa).
-%%--------------------------------------------------------------------
-ciphers_ecdsa_signed_certs_openssl_names() ->
- [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:openssl_ecdsa_suites(),
- run_suites(Ciphers, Config, ecdsa).
-%%--------------------------------------------------------------------
-ciphers_ecdh_rsa_signed_certs() ->
- [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion),
- run_suites(Ciphers, Config, ecdh_rsa).
-%%--------------------------------------------------------------------
-ciphers_ecdh_rsa_signed_certs_openssl_names() ->
- [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
-
-ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(),
- run_suites(Ciphers, Config, ecdh_rsa).
-%%--------------------------------------------------------------------
reuse_session() ->
[{doc,"Test reuse of sessions (short handshake)"}].
reuse_session(Config) when is_list(Config) ->
@@ -6356,147 +6138,6 @@ 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)}.
-run_suites(Ciphers, Config, Type) ->
- Version = ssl_test_lib:protocol_version(Config),
- ct:log("Running cipher suites ~p~n", [Ciphers]),
- {ClientOpts, ServerOpts} =
- case Type of
- rsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_rsa_opts, Config)]};
- dsa ->
- {ssl_test_lib:ssl_options(client_dsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_dsa_opts, Config)]};
- anonymous ->
- %% No certs in opts!
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options([], Config)]};
- psk ->
- {ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_psk, Config)]};
- psk_with_hint ->
- {ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_psk_hint, Config)
- ]};
- psk_anon ->
- {ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_psk_anon, Config)]};
- psk_anon_with_hint ->
- {ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
- srp ->
- {ssl_test_lib:ssl_options(client_srp, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_srp, Config)]};
- srp_anon ->
- {ssl_test_lib:ssl_options(client_srp, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_srp_anon, Config)]};
- srp_dsa ->
- {ssl_test_lib:ssl_options(client_srp_dsa, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_srp_dsa, Config)]};
- ecdsa ->
- {ssl_test_lib:ssl_options(client_ecdsa_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]};
- ecdh_rsa ->
- {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]};
- rc4_rsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]};
- rc4_ecdh_rsa ->
- {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]};
- rc4_ecdsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]};
- des_dhe_rsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_verification_opts, Config)]};
- des_rsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]};
- chacha_rsa ->
- {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]};
- chacha_ecdsa ->
- {ssl_test_lib:ssl_options(client_ecdsa_opts, Config),
- [{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}
- end,
- Suites = ssl_test_lib:filter_suites(Ciphers, Version),
- ct:pal("ssl_test_lib:filter_suites(~p ~p) -> ~p ", [Ciphers, Version, Suites]),
- Results0 = lists:map(fun(Cipher) ->
- cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
- ssl_test_lib:filter_suites(Ciphers, Version)),
- Results = lists:flatten(Results0),
- true = length(Results) == length(Suites),
- check_cipher_result(Results).
-
-check_cipher_result([]) ->
- ok;
-check_cipher_result([ok | Rest]) ->
- check_cipher_result(Rest);
-check_cipher_result([_ |_] = Error) ->
- ct:fail(Error).
-
-erlang_cipher_suite(Suite) when is_list(Suite)->
- ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite));
-erlang_cipher_suite(Suite) ->
- Suite.
-
-cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
- %% process_flag(trap_exit, true),
- ct:log("Testing CipherSuite ~p~n", [CipherSuite]),
- ct:log("Server Opts ~p~n", [ServerOpts]),
- ct:log("Client Opts ~p~n", [ClientOpts]),
- {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
- ErlangCipherSuite = erlang_cipher_suite(CipherSuite),
-
- ConnectionInfo = {ok, {Version, ErlangCipherSuite}},
-
- Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
- {options, ServerOpts}]),
- Port = ssl_test_lib:inet_port(Server),
- Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
- {options,
- [{ciphers,[CipherSuite]} |
- ClientOpts]}]),
-
- Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok),
-
- ssl_test_lib:close(Server),
- ssl_test_lib:close(Client),
-
- case Result of
- ok ->
- [ok];
- Error ->
- [{ErlangCipherSuite, Error}]
- end.
-
connection_information_result(Socket) ->
{ok, Info = [_ | _]} = ssl:connection_information(Socket),
case length(Info) > 3 of
diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl
index 6a2be0e267..bf1bc0e752 100644
--- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl
+++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl
@@ -50,25 +50,29 @@ groups() ->
{'dtlsv1', [], kex()},
{dhe_rsa, [],[dhe_rsa_3des_ede_cbc,
dhe_rsa_aes_128_cbc,
- dhe_rsa_aes_256_cbc
+ dhe_rsa_aes_256_cbc,
+ dhe_rsa_chacha20_poly1305
]},
{ecdhe_rsa, [], [ecdhe_rsa_3des_ede_cbc,
ecdhe_rsa_aes_128_cbc,
ecdhe_rsa_aes_128_gcm,
ecdhe_rsa_aes_256_cbc,
- ecdhe_rsa_aes_256_gcm
+ ecdhe_rsa_aes_256_gcm,
+ ecdhe_rsa_chacha20_poly1305
]},
{ecdhe_ecdsa, [],[ecdhe_ecdsa_rc4_128,
ecdhe_ecdsa_3des_ede_cbc,
ecdhe_ecdsa_aes_128_cbc,
ecdhe_ecdsa_aes_128_gcm,
ecdhe_ecdsa_aes_256_cbc,
- ecdhe_ecdsa_aes_256_gcm
+ ecdhe_ecdsa_aes_256_gcm,
+ ecdhe_ecdsa_chacha20_poly1305
]},
{rsa, [], [rsa_3des_ede_cbc,
rsa_aes_128_cbc,
rsa_aes_256_cbc,
- rsa_rc4_128]},
+ rsa_rc4_128
+ ]},
{dhe_dss, [], [dhe_dss_3des_ede_cbc,
dhe_dss_aes_128_cbc,
dhe_dss_aes_256_cbc]},
@@ -81,11 +85,7 @@ groups() ->
{rsa_psk, [], [rsa_psk_3des_ede_cbc,
rsa_psk_rc4_128,
rsa_psk_aes_128_cbc,
- %% rsa_psk_aes_128_ccm,
- %% rsa_psk_aes_128_ccm_8,
rsa_psk_aes_256_cbc
- %% rsa_psk_aes_256_ccm,
- %% rsa_psk_aes_256_ccm_8
]},
{dh_anon, [], [dh_anon_rc4_128,
dh_anon_3des_ede_cbc,
@@ -97,26 +97,33 @@ groups() ->
ecdh_anon_aes_128_cbc,
ecdh_anon_aes_256_cbc
]},
- {srp, [], [srp_3des_ede_cbc,
- srp_aes_128_cbc,
- srp_aes_256_cbc]},
+ {srp_anon, [], [srp_anon_3des_ede_cbc,
+ srp_anon_aes_128_cbc,
+ srp_anon_aes_256_cbc]},
{psk, [], [psk_3des_ede_cbc,
psk_rc4_128,
psk_aes_128_cbc,
- %% psk_aes_128_ccm,
- %% psk_aes_128_ccm_8,
- psk_aes_256_cbc
- %% psk_aes_256_ccm,
- %% psk_aes_256_ccm_8
+ psk_aes_128_ccm,
+ psk_aes_128_ccm_8,
+ psk_aes_256_cbc,
+ psk_aes_256_ccm,
+ psk_aes_256_ccm_8
]},
{dhe_psk, [], [dhe_psk_3des_ede_cbc,
dhe_psk_rc4_128,
dhe_psk_aes_128_cbc,
- %% dhe_psk_aes_128_ccm,
- %% dhe_psk_aes_128_ccm_8,
- dhe_psk_aes_256_cbc
- %% dhe_psk_aes_256_ccm,
- %% dhe_psk_aes_256_ccm_8
+ dhe_psk_aes_128_ccm,
+ dhe_psk_aes_128_ccm_8,
+ dhe_psk_aes_256_cbc,
+ dhe_psk_aes_256_ccm,
+ dhe_psk_aes_256_ccm_8
+ ]},
+ {ecdhe_psk, [], [ecdhe_psk_3des_ede_cbc,
+ ecdhe_psk_rc4_128,
+ ecdhe_psk_aes_128_cbc,
+ ecdhe_psk_aes_128_ccm,
+ ecdhe_psk_aes_128_ccm_8,
+ ecdhe_psk_aes_256_cbc
]}
].
@@ -144,7 +151,8 @@ anonymous() ->
{group, ecdh_anon},
{group, psk},
{group, dhe_psk},
- {group, srp}
+ {group, ecdhe_psk},
+ {group, srp_anon}
].
@@ -165,8 +173,16 @@ end_per_suite(_Config) ->
%%--------------------------------------------------------------------
init_per_group(GroupName, Config) when GroupName == ecdh_anon;
GroupName == ecdhe_rsa;
- GroupName == ecdhe_ecdsa ->
- case ssl_test_lib:sufficient_crypto_support(ec_cipher) of
+ GroupName == ecdhe_psk ->
+ case proplists:get_bool(ecdh, proplists:get_value(public_keys, crypto:supports())) of
+ true ->
+ init_certs(GroupName, Config);
+ false ->
+ {skip, "Missing EC crypto support"}
+ end;
+init_per_group(ecdhe_ecdsa = GroupName, Config) ->
+ PKAlg = proplists:get_value(public_keys, crypto:supports()),
+ case lists:member(ecdh, PKAlg) andalso lists:member(ecdsa, PKAlg) of
true ->
init_certs(GroupName, Config);
false ->
@@ -188,7 +204,7 @@ init_per_group(srp_dss = GroupName, Config) ->
false ->
{skip, "Missing DSS_SRP crypto support"}
end;
-init_per_group(GroupName, Config) when GroupName == srp;
+init_per_group(GroupName, Config) when GroupName == srp_anon;
GroupName == srp_rsa ->
PKAlg = proplists:get_value(public_keys, crypto:supports()),
case lists:member(srp, PKAlg) of
@@ -221,27 +237,30 @@ end_per_group(GroupName, Config) ->
Config
end.
init_per_testcase(TestCase, Config) when TestCase == psk_3des_ede_cbc;
- TestCase == srp_3des_ede_cbc;
+ TestCase == srp_anon_3des_ede_cbc;
TestCase == dhe_psk_3des_ede_cbc;
+ TestCase == ecdhe_psk_3des_ede_cbc;
TestCase == srp_rsa_3des_ede_cbc;
+ TestCase == srp_dss_3des_ede_cbc;
TestCase == rsa_psk_3des_ede_cbc;
TestCase == rsa_3des_ede_cbc;
TestCase == dhe_rsa_3des_ede_cbc;
TestCase == dhe_dss_3des_ede_cbc;
TestCase == ecdhe_rsa_3des_ede_cbc;
- TestCase == srp_dss_3des_ede_cbc;
+ TestCase == srp_anon_dss_3des_ede_cbc;
TestCase == dh_anon_3des_ede_cbc;
TestCase == ecdh_anon_3des_ede_cbc;
TestCase == ecdhe_ecdsa_3des_ede_cbc ->
SupCiphers = proplists:get_value(ciphers, crypto:supports()),
case lists:member(des_ede3, SupCiphers) of
true ->
- ct:timetrap({seconds, 2}),
+ ct:timetrap({seconds, 5}),
Config;
_ ->
{skip, "Missing 3DES crypto support"}
end;
init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128;
+ TestCase == ecdhe_psk_rc4_128;
TestCase == dhe_psk_rc4_128;
TestCase == rsa_psk_rc4_128;
TestCase == rsa_rc4_128;
@@ -251,18 +270,44 @@ init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128;
SupCiphers = proplists:get_value(ciphers, crypto:supports()),
case lists:member(rc4, SupCiphers) of
true ->
- ct:timetrap({seconds, 2}),
+ ct:timetrap({seconds, 5}),
Config;
_ ->
{skip, "Missing RC4 crypto support"}
end;
-init_per_testcase(TestCase, Config) ->
+init_per_testcase(TestCase, Config) when TestCase == psk_aes_128_ccm_8;
+ TestCase == rsa_psk_aes_128_ccm_8;
+ TestCase == psk_aes_128_ccm_8;
+ TestCase == dhe_psk_aes_128_ccm_8;
+ TestCase == ecdhe_psk_aes_128_ccm_8 ->
+ SupCiphers = proplists:get_value(ciphers, crypto:supports()),
+ case lists:member(aes_128_ccm, SupCiphers) of
+ true ->
+ ct:timetrap({seconds, 5}),
+ Config;
+ _ ->
+ {skip, "Missing AES_128_CCM crypto support"}
+ end;
+init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8;
+ TestCase == rsa_psk_aes_256_ccm_8;
+ TestCase == psk_aes_256_ccm_8;
+ TestCase == dhe_psk_aes_256_ccm_8;
+ TestCase == ecdhe_psk_aes_256_ccm_8 ->
+ SupCiphers = proplists:get_value(ciphers, crypto:supports()),
+ case lists:member(aes_256_ccm, SupCiphers) of
+ true ->
+ ct:timetrap({seconds, 5}),
+ Config;
+ _ ->
+ {skip, "Missing AES_256_CCM crypto support"}
+ end;
+init_per_testcase(TestCase, Config) ->
Cipher = test_cipher(TestCase, Config),
%%Reason = io_lib:format("Missing ~p crypto support", [Cipher]),
SupCiphers = proplists:get_value(ciphers, crypto:supports()),
case lists:member(Cipher, SupCiphers) of
true ->
- ct:timetrap({seconds, 2}),
+ ct:timetrap({seconds, 5}),
Config;
_ ->
{skip, {Cipher, SupCiphers}}
@@ -280,6 +325,10 @@ init_certs(srp_rsa, Config) ->
[{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}} | ServerOpts],
client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} |
proplists:delete(tls_config, Config)];
+init_certs(srp_anon, Config) ->
+ [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}}],
+ client_config => [{srp_identity, {"Test-User", "secret"}}]}} |
+ proplists:delete(tls_config, Config)];
init_certs(rsa_psk, Config) ->
ClientExt = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]),
{ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain,
@@ -337,7 +386,8 @@ init_certs(GroupName, Config) when GroupName == dhe_ecdsa;
client_config => ClientOpts}} |
proplists:delete(tls_config, Config)];
init_certs(GroupName, Config) when GroupName == psk;
- GroupName == dhe_psk ->
+ GroupName == dhe_psk;
+ GroupName == ecdhe_psk ->
PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>,
[{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}],
client_config => [{psk_identity, "Test-User"},
@@ -443,7 +493,10 @@ dhe_rsa_aes_256_cbc(Config) when is_list(Config) ->
run_ciphers_test(dhe_rsa, 'aes_256_cbc', Config).
dhe_rsa_aes_256_gcm(Config) when is_list(Config) ->
- run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config).
+ run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config).
+
+dhe_rsa_chacha20_poly1305(Config) when is_list(Config) ->
+ run_ciphers_test(dhe_rsa, 'chacha20_poly1305', Config).
%%--------------------------------------------------------------------
%% ECDHE_RSA --------------------------------------------------------
%%--------------------------------------------------------------------
@@ -464,6 +517,10 @@ ecdhe_rsa_aes_256_gcm(Config) when is_list(Config) ->
ecdhe_rsa_rc4_128(Config) when is_list(Config) ->
run_ciphers_test(ecdhe_rsa, 'rc4_128', Config).
+
+ecdhe_rsa_chacha20_poly1305(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_rsa, 'chacha20_poly1305', Config).
+
%%--------------------------------------------------------------------
%% ECDHE_ECDSA --------------------------------------------------------
%%--------------------------------------------------------------------
@@ -485,6 +542,8 @@ ecdhe_ecdsa_aes_256_cbc(Config) when is_list(Config) ->
ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) ->
run_ciphers_test(ecdhe_ecdsa, 'aes_256_gcm', Config).
+ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config).
%%--------------------------------------------------------------------
%% DHE_DSS --------------------------------------------------------
%%--------------------------------------------------------------------
@@ -536,14 +595,14 @@ ecdh_anon_aes_128_cbc(Config) when is_list(Config) ->
ecdh_anon_aes_256_cbc(Config) when is_list(Config) ->
run_ciphers_test(ecdh_anon, 'aes_256_cbc', Config).
-srp_3des_ede_cbc(Config) when is_list(Config) ->
- run_ciphers_test(srp, '3des_ede_cbc', Config).
+srp_anon_3des_ede_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(srp_anon, '3des_ede_cbc', Config).
-srp_aes_128_cbc(Config) when is_list(Config) ->
- run_ciphers_test(srp, 'aes_128_cbc', Config).
+srp_anon_aes_128_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(srp_anon, 'aes_128_cbc', Config).
-srp_aes_256_cbc(Config) when is_list(Config) ->
- run_ciphers_test(srp, 'aes_256_cbc', Config).
+srp_anon_aes_256_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(srp_anon, 'aes_256_cbc', Config).
dhe_psk_des_cbc(Config) when is_list(Config) ->
run_ciphers_test(dhe_psk, 'des_cbc', Config).
@@ -578,6 +637,33 @@ dhe_psk_aes_128_ccm_8(Config) when is_list(Config) ->
dhe_psk_aes_256_ccm_8(Config) when is_list(Config) ->
run_ciphers_test(dhe_psk, 'aes_256_ccm_8', Config).
+ecdhe_psk_des_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'des_cbc', Config).
+
+ecdhe_psk_rc4_128(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'rc4_128', Config).
+
+ecdhe_psk_3des_ede_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, '3des_ede_cbc', Config).
+
+ecdhe_psk_aes_128_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_128_cbc', Config).
+
+ecdhe_psk_aes_256_cbc(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_256_cbc', Config).
+
+ecdhe_psk_aes_128_gcm(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_128_gcm', Config).
+
+ecdhe_psk_aes_256_gcm(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_256_gcm', Config).
+
+ecdhe_psk_aes_128_ccm(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_128_ccm', Config).
+
+ecdhe_psk_aes_128_ccm_8(Config) when is_list(Config) ->
+ run_ciphers_test(ecdhe_psk, 'aes_128_ccm_8', Config).
+
psk_des_cbc(Config) when is_list(Config) ->
run_ciphers_test(psk, 'des_cbc', Config).
@@ -654,9 +740,8 @@ cipher_suite_test(CipherSuite, Version, Config) ->
{host, Hostname},
{from, self()},
{mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
- {options,
- [{versions, [Version]}, {ciphers, [CipherSuite]} |
- ClientOpts]}]),
+ {options, [{versions, [Version]}, {ciphers, [CipherSuite]} |
+ ClientOpts]}]),
ssl_test_lib:check_result(Server, ok, Client, ok),
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
index 7e7de5c9bf..1fea6f6f72 100644
--- a/lib/ssl/test/ssl_dist_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -49,10 +49,14 @@
suite() -> [{ct_hooks, [{ts_install_cth, [{nodenames, 2}]}]}].
-all() -> [{group, ssl}, {group, plain}].
+all() ->
+ [{group, ssl},
+ {group, crypto},
+ {group, plain}].
groups() ->
[{ssl, all_groups()},
+ {crypto, all_groups()},
{plain, all_groups()},
%%
{setup, [{repeat, 1}], [setup]},
@@ -164,6 +168,17 @@ end_per_suite(Config) ->
init_per_group(ssl, Config) ->
[{ssl_dist, true}, {ssl_dist_prefix, "SSL"}|Config];
+init_per_group(crypto, Config) ->
+ case inet_crypto_dist:is_supported() of
+ true ->
+ [{ssl_dist, false}, {ssl_dist_prefix, "Crypto"},
+ {ssl_dist_args,
+ "-proto_dist inet_crypto "
+ "-inet_crypto '#{secret => \"123456\"}'"}
+ |Config];
+ false ->
+ {skip, "Not supported on this OTP version"}
+ end;
init_per_group(plain, Config) ->
[{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config];
init_per_group(_GroupName, Config) ->
@@ -374,29 +389,46 @@ sched_utilization(A, B, Prefix, HA, HB, SSL) ->
[A] = ssl_apply(HB, erlang, nodes, []),
msacc:print(ClientMsacc),
msacc:print(ServerMsacc),
- ct:pal("Got ~p msgs",[length(Msgs)]),
- report(Prefix++" Sched Utilization Client",
- 10000 * msacc:stats(system_runtime,ClientMsacc) /
- msacc:stats(system_realtime,ClientMsacc), "util 0.01 %"),
- report(Prefix++" Sched Utilization Server",
- 10000 * msacc:stats(system_runtime,ServerMsacc) /
- msacc:stats(system_realtime,ServerMsacc), "util 0.01 %"),
- ok.
+ ct:pal("Got ~p busy_dist_port msgs",[length(Msgs)]),
+ ct:log("Stats of B from A: ~p",
+ [ssl_apply(HA, net_kernel, node_info, [B])]),
+ ct:log("Stats of A from B: ~p",
+ [ssl_apply(HB, net_kernel, node_info, [A])]),
+ SchedUtilClient =
+ round(10000 * msacc:stats(system_runtime,ClientMsacc) /
+ msacc:stats(system_realtime,ClientMsacc)),
+ SchedUtilServer =
+ round(10000 * msacc:stats(system_runtime,ServerMsacc) /
+ msacc:stats(system_realtime,ServerMsacc)),
+ Verdict =
+ case Msgs of
+ [] ->
+ "";
+ _ ->
+ " ???"
+ end,
+ {comment, ClientComment} =
+ report(Prefix ++ " Sched Utilization Client" ++ Verdict,
+ SchedUtilClient, "/100 %" ++ Verdict),
+ {comment, ServerComment} =
+ report(Prefix++" Sched Utilization Server" ++ Verdict,
+ SchedUtilServer, "/100 %" ++ Verdict),
+ {comment, "Client " ++ ClientComment ++ ", Server " ++ ServerComment}.
%% Runs on node A and spawns a server on node B
%% We want to avoid getting busy_dist_port as it hides the true SU usage
%% of the receiver and sender.
sched_util_runner(A, B, true) ->
- sched_util_runner(A, B, 50);
+ sched_util_runner(A, B, 250);
sched_util_runner(A, B, false) ->
sched_util_runner(A, B, 250);
sched_util_runner(A, B, Senders) ->
Payload = payload(5),
[A] = rpc:call(B, erlang, nodes, []),
- ServerPid =
- erlang:spawn(
- B,
- fun () -> throughput_server() end),
+ ServerPids =
+ [erlang:spawn_link(
+ B, fun () -> throughput_server() end)
+ || _ <- lists:seq(1, Senders)],
ServerMsacc =
erlang:spawn(
B,
@@ -404,24 +436,28 @@ sched_util_runner(A, B, Senders) ->
receive
{start,Pid} ->
msacc:start(10000),
- Pid ! {ServerPid,msacc:stats()}
+ receive
+ {done,Pid} ->
+ Pid ! {self(),msacc:stats()}
+ end
end
end),
- spawn_link(
- fun() ->
- %% We spawn 250 senders which should mean that we
- %% have a load of 250 msgs/msec
- [spawn_link(
- fun() ->
- throughput_client(ServerPid,Payload)
- end) || _ <- lists:seq(1, Senders)]
- end),
-
erlang:system_monitor(self(),[busy_dist_port]),
+ %% We spawn 250 senders which should mean that we
+ %% have a load of 250 msgs/msec
+ [spawn_link(
+ fun() ->
+ throughput_client(Pid, Payload)
+ end) || Pid <- ServerPids],
+ %%
+ receive after 1000 -> ok end,
ServerMsacc ! {start,self()},
msacc:start(10000),
ClientMsaccStats = msacc:stats(),
- ServerMsaccStats = receive {ServerPid,Stats} -> Stats end,
+ receive after 1000 -> ok end,
+ ServerMsacc ! {done,self()},
+ ServerMsaccStats = receive {ServerMsacc,Stats} -> Stats end,
+ %%
{ClientMsaccStats,ServerMsaccStats, flush()}.
flush() ->
@@ -522,15 +558,20 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) ->
+ byte_size(erlang:term_to_binary([0|<<>>])), % Benchmark overhead
Bytes = Packets * (Size + Overhead),
io:format("~w bytes, ~.4g s~n", [Bytes,Time/1000000]),
+ SizeString = integer_to_list(Size),
ClientMsaccStats =:= undefined orelse
- io:format(
- "Sender core usage ratio: ~.4g ns/byte~n",
- [msacc:stats(system_runtime, ClientMsaccStats)*1000/Bytes]),
+ report(
+ Prefix ++ " Sender_RelativeCoreLoad_" ++ SizeString,
+ round(msacc:stats(system_runtime, ClientMsaccStats)
+ * 1000000 / Bytes),
+ "ps/byte"),
ServerMsaccStats =:= undefined orelse
begin
- io:format(
- "Receiver core usage ratio: ~.4g ns/byte~n",
- [msacc:stats(system_runtime, ServerMsaccStats)*1000/Bytes]),
+ report(
+ Prefix ++ " Receiver_RelativeCoreLoad_" ++ SizeString,
+ round(msacc:stats(system_runtime, ServerMsaccStats)
+ * 1000000 / Bytes),
+ "ps/byte"),
msacc:print(ServerMsaccStats)
end,
io:format("******* ClientProf:~n", []), prof_print(ClientProf),
@@ -538,7 +579,7 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) ->
io:format("******* Server GC Before:~n~p~n", [Server_GC_Before]),
io:format("******* Server GC After:~n~p~n", [Server_GC_After]),
Speed = round((Bytes * 1000000) / (1024 * Time)),
- report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s").
+ report(Prefix ++ " Throughput_" ++ SizeString, Speed, "kB/s").
%% Runs on node A and spawns a server on node B
throughput_runner(A, B, Rounds, Size) ->
@@ -546,11 +587,12 @@ throughput_runner(A, B, Rounds, Size) ->
[A] = rpc:call(B, erlang, nodes, []),
ClientPid = self(),
ServerPid =
- erlang:spawn(
+ erlang:spawn_opt(
B,
- fun () -> throughput_server(ClientPid, Rounds) end),
+ fun () -> throughput_server(ClientPid, Rounds) end,
+ [{message_queue_data, off_heap}]),
ServerMon = erlang:monitor(process, ServerPid),
- msacc:available() andalso
+ msacc_available() andalso
begin
msacc:stop(),
msacc:reset(),
@@ -562,7 +604,7 @@ throughput_runner(A, B, Rounds, Size) ->
throughput_client(ServerPid, ServerMon, Payload, Rounds),
prof_stop(),
MsaccStats =
- case msacc:available() of
+ case msacc_available() of
true ->
MStats = msacc:stats(),
msacc:stop(),
@@ -602,7 +644,7 @@ throughput_server(Pid, N) ->
GC_Before = get_server_gc_info(),
%% dbg:tracer(port, dbg:trace_port(file, "throughput_server_gc.log")),
%% dbg:p(TLSDistReceiver, garbage_collection),
- msacc:available() andalso
+ msacc_available() andalso
begin
msacc:stop(),
msacc:reset(),
@@ -615,7 +657,7 @@ throughput_server(Pid, N) ->
throughput_server_loop(_Pid, GC_Before, 0) ->
prof_stop(),
MsaccStats =
- case msacc:available() of
+ case msacc_available() of
true ->
msacc:stop(),
MStats = msacc:stats(),
@@ -632,8 +674,13 @@ throughput_server_loop(_Pid, GC_Before, 0) ->
server_gc_after => get_server_gc_info()});
throughput_server_loop(Pid, GC_Before, N) ->
receive
- {Pid, N, _} ->
- throughput_server_loop(Pid, GC_Before, N-1)
+ Msg ->
+ case Msg of
+ {Pid, N, _} ->
+ throughput_server_loop(Pid, GC_Before, N - 1);
+ Other ->
+ erlang:error({self(),?FUNCTION_NAME,Other})
+ end
end.
get_server_gc_info() ->
@@ -773,7 +820,7 @@ get_node_args(Tag, Config) ->
true ->
proplists:get_value(Tag, Config);
false ->
- ""
+ proplists:get_value(ssl_dist_args, Config, "")
end.
@@ -828,3 +875,6 @@ report(Name, Value, Unit) ->
term_to_string(Term) ->
unicode:characters_to_list(
io_lib:write(Term, [{encoding, unicode}])).
+
+msacc_available() ->
+ msacc:available().
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index f79f57fbd7..22169035f3 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -1533,10 +1533,13 @@ cipher_result(Socket, Result) ->
ct:log("~p:~p~nSuccessfull connect: ~p~n", [?MODULE,?LINE, Result]),
%% Importante to send two packets here
%% to properly test "cipher state" handling
- ssl:send(Socket, "Hello\n"),
- "Hello\n" = active_recv(Socket, length( "Hello\n")),
- ssl:send(Socket, " world\n"),
- " world\n" = active_recv(Socket, length(" world\n")),
+ Hello = "Hello\n",
+ World = " world\n",
+ ssl:send(Socket, Hello),
+ ct:sleep(500),
+ ssl:send(Socket, World),
+ Expected = Hello ++ World,
+ Expected = active_recv(Socket, length(Expected)),
ok.
session_info_result(Socket) ->
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index df84411b6d..f22eb4ecdf 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -39,16 +39,14 @@
all() ->
case ssl_test_lib:openssl_sane_dtls() of
true ->
- [{group, basic},
- {group, 'tlsv1.2'},
+ [{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
{group, 'sslv3'},
{group, 'dtlsv1.2'},
{group, 'dtlsv1'}];
false ->
- [{group, basic},
- {group, 'tlsv1.2'},
+ [{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
{group, 'sslv3'}]
@@ -57,8 +55,7 @@ all() ->
groups() ->
case ssl_test_lib:openssl_sane_dtls() of
true ->
- [{basic, [], basic_tests()},
- {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ [{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'sslv3', [], all_versions_tests()},
@@ -66,20 +63,13 @@ groups() ->
{'dtlsv1', [], dtls_all_versions_tests()}
];
false ->
- [{basic, [], basic_tests()},
- {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ [{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'sslv3', [], all_versions_tests()}
]
end.
-
-basic_tests() ->
- [basic_erlang_client_openssl_server,
- basic_erlang_server_openssl_client,
- expired_session
- ].
-
+
all_versions_tests() ->
[
erlang_client_openssl_server,
@@ -357,85 +347,7 @@ end_per_testcase(_, Config) ->
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
-basic_erlang_client_openssl_server() ->
- [{doc,"Test erlang client with openssl server"}].
-basic_erlang_client_openssl_server(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
-
- {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
- Data = "From openssl to erlang",
-
- Port = ssl_test_lib:inet_port(node()),
- CertFile = proplists:get_value(certfile, ServerOpts),
- KeyFile = proplists:get_value(keyfile, ServerOpts),
-
- Exe = "openssl",
- Args = ["s_server", "-accept", integer_to_list(Port),
- "-cert", CertFile, "-key", KeyFile],
-
- OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
-
-
- ssl_test_lib:wait_for_openssl_server(Port, tls),
-
- Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
- true = port_command(OpensslPort, Data),
-
- ssl_test_lib:check_result(Client, ok),
-
- %% Clean close down! Server needs to be closed first !!
- ssl_test_lib:close_port(OpensslPort),
- ssl_test_lib:close(Client),
- process_flag(trap_exit, false).
-
-%%--------------------------------------------------------------------
-basic_erlang_server_openssl_client() ->
- [{doc,"Test erlang server with openssl client"}].
-basic_erlang_server_openssl_client(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
-
- {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
- Data = "From openssl to erlang",
- Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options,ServerOpts}]),
-
- Port = ssl_test_lib:inet_port(Server),
-
- Exe = "openssl",
- Args = case no_low_flag("-no_ssl2") of
- [] ->
- ["s_client", "-connect", hostname_format(Hostname) ++
- ":" ++ integer_to_list(Port), no_low_flag("-no_ssl3")
- | workaround_openssl_s_clinent()];
- Flag ->
- ["s_client", "-connect", hostname_format(Hostname) ++
- ":" ++ integer_to_list(Port), no_low_flag("-no_ssl3"), Flag
- | workaround_openssl_s_clinent()]
- end,
-
- OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- true = port_command(OpenSslPort, Data),
-
- ssl_test_lib:check_result(Server, ok),
-
- %% Clean close down! Server needs to be closed first !!
- ssl_test_lib:close(Server),
- ssl_test_lib:close_port(OpenSslPort),
- process_flag(trap_exit, false).
-%%--------------------------------------------------------------------
erlang_client_openssl_server() ->
[{doc,"Test erlang client with openssl server"}].
erlang_client_openssl_server(Config) when is_list(Config) ->
diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl
index 875399db76..ead18aeb73 100644
--- a/lib/ssl/test/ssl_upgrade_SUITE.erl
+++ b/lib/ssl/test/ssl_upgrade_SUITE.erl
@@ -47,10 +47,7 @@ init_per_suite(Config0) ->
{skip, Reason} ->
{skip, Reason};
Config ->
- Result =
- {ok, _} = make_certs:all(proplists:get_value(data_dir, Config),
- proplists:get_value(priv_dir, Config)),
- ssl_test_lib:cert_options(Config)
+ ssl_test_lib:make_rsa_cert(Config)
end
catch _:_ ->
{skip, "Crypto did not start"}
@@ -149,8 +146,8 @@ use_connection(Socket) ->
end.
soft_start_connection(Config, ResulProxy) ->
- ClientOpts = proplists:get_value(client_verification_opts, Config),
- ServerOpts = proplists:get_value(server_verification_opts, Config),
+ ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = start_server([{node, ServerNode}, {port, 0},
{from, ResulProxy},
@@ -166,8 +163,8 @@ soft_start_connection(Config, ResulProxy) ->
{Server, Client}.
restart_start_connection(Config, ResulProxy) ->
- ClientOpts = proplists:get_value(client_verification_opts, Config),
- ServerOpts = proplists:get_value(server_verification_opts, Config),
+ ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = start_server([{node, ServerNode}, {port, 0},
{from, ResulProxy},
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index 23c3f6e981..65650a25c7 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -31,6 +31,21 @@
</header>
<p>This document describes the changes made to the STDLIB application.</p>
+<section><title>STDLIB 3.8.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed a performance regression when reading files
+ opened with the <c>compressed</c> flag.</p>
+ <p>
+ Own Id: OTP-15706 Aux Id: ERIERL-336 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>STDLIB 3.8</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index d8b8f466b1..7064fcacfa 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -324,7 +324,7 @@ do_open(Name, Mode) when is_list(Mode) ->
open1({binary,Bin}, read, _Raw, Opts) when is_binary(Bin) ->
case file:open(Bin, [ram,binary,read]) of
{ok,File} ->
- _ = [ram_file:uncompress(File) || Opts =:= [compressed]],
+ _ = [ram_file:uncompress(File) || lists:member(compressed, Opts)],
{ok, #reader{handle=File,access=read,func=fun file_op/2}};
Error ->
Error
@@ -357,7 +357,7 @@ open_mode([read|Rest], false, Raw, Opts) ->
open_mode([write|Rest], false, Raw, Opts) ->
open_mode(Rest, write, Raw, Opts);
open_mode([compressed|Rest], Access, Raw, Opts) ->
- open_mode(Rest, Access, Raw, [compressed|Opts]);
+ open_mode(Rest, Access, Raw, [compressed,read_ahead|Opts]);
open_mode([cooked|Rest], Access, _Raw, Opts) ->
open_mode(Rest, Access, [], Opts);
open_mode([], Access, Raw, Opts) ->
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 37ea97c353..08612ed17f 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -41,7 +41,9 @@
{<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.7$">>,[restart_new_emulator]},
{<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
+ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.8$">>,[restart_new_emulator]},
+ {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}],
[{<<"^3\\.4$">>,[restart_new_emulator]},
{<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
@@ -56,4 +58,6 @@
{<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.7$">>,[restart_new_emulator]},
{<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
+ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.8$">>,[restart_new_emulator]},
+ {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}.
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index cbefd6590a..6471dc70e0 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1 +1 @@
-STDLIB_VSN = 3.8
+STDLIB_VSN = 3.8.1
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index 6b42f7a0a1..e1dd1bd73b 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -74,7 +74,7 @@ smoke_test_file(File) ->
[print_error_markers(F, File) || F <- Forms],
ok;
{error,Reason} ->
- io:format("~s: ~p\n", [File,Reason]),
+ io:format("~ts: ~p\n", [File,Reason]),
error
end.
@@ -82,7 +82,7 @@ print_error_markers(F, File) ->
case erl_syntax:type(F) of
error_marker ->
{L,M,Info} = erl_syntax:error_marker_info(F),
- io:format("~ts:~p: ~s", [File,L,M:format_error(Info)]);
+ io:format("~ts:~p: ~ts", [File,L,M:format_error(Info)]);
_ ->
ok
end.
@@ -362,7 +362,7 @@ test_comment_scan([File|Files],DataDir) ->
end,
Fs1 = erl_recomment:recomment_forms(Fs0, Comments),
Fs2 = erl_syntax_lib:map(Fun, Fs1),
- io:format("File: ~s~n", [Filename]),
+ io:format("File: ~ts~n", [Filename]),
io:put_chars(erl_prettypr:format(Fs2, [{paper, 120},
{ribbon, 110}])),
test_comment_scan(Files,DataDir).
@@ -377,8 +377,8 @@ test_prettypr([File|Files],DataDir,PrivDir) ->
PP = erl_prettypr:format(Fs, [{paper, 120}, {ribbon, 110}]),
io:put_chars(PP),
OutFile = filename:join(PrivDir, File),
- ok = file:write_file(OutFile,iolist_to_binary(PP)),
- io:format("Parsing OutFile: ~s~n", [OutFile]),
+ ok = file:write_file(OutFile,unicode:characters_to_binary(PP)),
+ io:format("Parsing OutFile: ~ts~n", [OutFile]),
{ok, Fs2} = epp:parse_file(OutFile, [], []),
case [Error || {error, _} = Error <- Fs2] of
[] ->
@@ -445,7 +445,7 @@ pretty_print_parse_forms([{Fs0,Type}|FsForms],PrivDir,Filename) ->
{Fs2,{CC,CT}} = erl_syntax_lib:mapfold(Comment,{0,0}, Fs1),
io:format("Commented on ~w cases and ~w tries~n", [CC,CT]),
PP = erl_prettypr:format(Fs2),
- ok = file:write_file(OutFile,iolist_to_binary(PP)),
+ ok = file:write_file(OutFile,unicode:characters_to_binary(PP)),
pretty_print_parse_forms(FsForms,PrivDir,Filename).
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
index 2ee584d11a..fbdd298da3 100644
--- a/lib/tools/emacs/erlang-test.el
+++ b/lib/tools/emacs/erlang-test.el
@@ -50,8 +50,15 @@
;; The -L option adds a directory to the load-path. It should be the
;; directory containing erlang.el and erlang-test.el.
;;
-;; 3. Call the script test-erlang-mode in this directory. This script
-;; use the second method.
+;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and
+;; tests_compiled/1 in this suite are using the second method. One
+;; way to run this suite is with the ct_run tool, for example like the
+;; following when standing at the OTP repo top directory:
+;;
+;; ct_run -suite lib/tools/test/emacs_SUITE
+;;
+;; Note that this creates a lot of html log files in the current
+;; directory.
;;; Code:
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 38c0eba92b..0b3a2319e2 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -4,7 +4,7 @@
;; Author: Anders Lindgren
;; Keywords: erlang, languages, processes
;; Date: 2011-12-11
-;; Version: 2.8.1
+;; Version: 2.8.2
;; Package-Requires: ((emacs "24.1"))
;; %CopyrightBegin%
@@ -87,7 +87,7 @@
"The Erlang programming language."
:group 'languages)
-(defconst erlang-version "2.8.1"
+(defconst erlang-version "2.8.2"
"The version number of Erlang mode.")
(defcustom erlang-root-dir nil
@@ -502,6 +502,13 @@ regardless of where in the line point is when the TAB command is used."
:type 'boolean
:safe 'booleanp)
+(defcustom erlang-max-files-to-visit-for-refining-xrefs 32
+ "Upper limit how many files to visit for checking arity.
+When `nil' there is no limit."
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :safe (lambda (val) (or (eq val nil) (integerp val))))
+
(defvar erlang-man-inhibit (eq system-type 'windows-nt)
"Inhibit the creation of the Erlang Manual Pages menu.
@@ -3689,10 +3696,13 @@ When an identifier is found return a list with 4 elements:
module or nil.
2. Module - Module name string or nil. In case of a
-qualified-function a search fails if no entries with correct
-module are found. For other kinds the module is just a
-preference. If no matching entries are found the search will be
-retried without regard to module.
+qualified-function the module is explicitly specified (like
+module:fun()) and the search fails if no entries with correct
+module are found. For other kinds the module is guessed: either
+fetched from import statements or it is assumed to be the local
+module. In these cases the module is just a preference. If no
+matching entries are found the search will be retried without
+regard to module.
3. Name - String name of function, module, record or macro.
@@ -3704,18 +3714,22 @@ of arguments could be found, otherwise nil."
(if (eq (char-syntax (following-char)) ? )
(skip-chars-backward " \t"))
(skip-chars-backward "[:word:]_:'")
- (cond ((looking-at erlang-module-function-regexp)
+ (cond ((and (eq (preceding-char) ??)
+ (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp)))
+ (erlang-get-qualified-function-id-at-point (erlang-get-module)))
+ ((looking-at erlang-module-function-regexp)
(erlang-get-qualified-function-id-at-point))
((looking-at (concat erlang-atom-regexp ":"))
(erlang-get-module-id-at-point))
((looking-at erlang-name-regexp)
(erlang-get-some-other-id-at-point)))))))
-(defun erlang-get-qualified-function-id-at-point ()
+(defun erlang-get-qualified-function-id-at-point (&optional module)
(let ((kind 'qualified-function)
- (module (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))))
+ (module (or module
+ (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))))
(name (erlang-remove-quotes
(buffer-substring-no-properties
(match-beginning (1+ erlang-atom-regexp-matches))
@@ -3825,7 +3839,8 @@ of arguments could be found, otherwise nil."
(let ((case-fold-search nil)) ; force string matching to be case sensitive
(if (and (stringp str)
(not (string-match (eval-when-compile
- (concat "\\`" erlang-atom-regexp "\\'")) str)))
+ (concat "\\`" erlang-atom-regexp "\\'"))
+ str)))
(progn
(setq str (replace-regexp-in-string "'" "\\'" str t t ))
(concat "'" str "'"))
@@ -4879,15 +4894,36 @@ about Erlang modules."
;; The backend below is a wrapper around the built-in etags backend.
;; It adds awareness of the module:tag syntax in a similar way that is
;; done above for the old etags commands.
+;;
+;; In addition arity is also considered when jumping to definitions.
+;; There is however currently no information about arity in the TAGS
+;; file. Also two functions with the same name but different arity
+;; _sometimes_ get one TAGS entry each and sometimes are joined in one
+;; single entry. If they are directly consecutive they will be
+;; joined. If there are other functions etc in between then they will
+;; get one entry each.
+;;
+;; These limitations are present in both the etags program shipped
+;; with GNU Emacs and the tags.erl program in this repository.
+;;
+;; Therefore erlang.el must complement the information in TAGS by
+;; visiting files and checking arity. When searching for popular
+;; function names (like init, handle_call etc) in a big TAGS file
+;; (like one indexing this repository) this may be quite
+;; time-consuming. There exists therefore an upper limit for the
+;; number of files to visit (called
+;; `erlang-max-files-to-visit-for-refining-xrefs').
+;;
+;; As mentioned this xref implementation is based on the etags xref
+;; implementation. But in the cases where arity is considered the
+;; etags information structures (class xref-etags-location) will be
+;; translated to our own structures which include arity (class
+;; erlang-xref-location). This translation is started in the function
+;; `erlang-refine-xrefs'.
-(defvar erlang-current-arity nil
- "The arity of the function currently being searched.
-
-There is no information about arity in the TAGS file.
-Consecutive functions with same name but different arity will
-only get one entry in the TAGS file. Matching TAGS entries are
-therefore selected without regarding arity. The arity is
-considered first when it is time to jump to the definition.")
+;; I mention this as a head up that some of the functions below deal
+;; with xref items with xref-etags-location and some deal with xref
+;; items with erlang-xref-location.
(defun erlang-etags--xref-backend () 'erlang-etags)
@@ -4895,127 +4931,80 @@ considered first when it is time to jump to the definition.")
(when (locate-library (symbol-name feature))
(require feature)))
-(and (erlang-soft-require 'xref)
- (erlang-soft-require 'cl-generic)
- (erlang-soft-require 'eieio)
- (erlang-soft-require 'etags)
- ;; The purpose of using eval here is to avoid compilation
- ;; warnings in emacsen without cl-defmethod etc.
- (eval
- '(progn
- (cl-defmethod xref-backend-identifier-at-point
- ((_backend (eql erlang-etags)))
- (if (eq this-command 'xref-find-references)
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning)
- (region-end))
- (thing-at-point 'symbol))
- (erlang-id-to-string (erlang-get-identifier-at-point))))
-
- (cl-defmethod xref-backend-definitions
- ((_backend (eql erlang-etags)) identifier)
- (erlang-xref-find-definitions identifier))
-
- (cl-defmethod xref-backend-apropos
- ((_backend (eql erlang-etags)) identifier)
- (erlang-xref-find-definitions identifier t))
-
- (cl-defmethod xref-backend-identifier-completion-table
- ((_backend (eql erlang-etags)))
- (let ((erlang-replace-etags-tags-completion-table t))
- (tags-completion-table)))
-
- (defclass erlang-xref-location (xref-etags-location) ())
-
- (defun erlang-convert-xrefs (xrefs)
- (mapcar (lambda (xref)
- (oset xref location (erlang-make-location
- (oref xref location)))
- xref)
- xrefs))
-
- (defun erlang-make-location (etags-location)
- (with-slots (tag-info file) etags-location
- (make-instance 'erlang-xref-location :tag-info tag-info
- :file file)))
-
- (cl-defmethod xref-location-marker ((locus erlang-xref-location))
- (with-slots (tag-info file) locus
- (with-current-buffer (find-file-noselect file)
- (save-excursion
- (or (erlang-goto-tag-location-by-arity tag-info)
- (etags-goto-tag-location tag-info))
- ;; Reset erlang-current-arity. We want to jump to
- ;; correct arity in the first attempt. That is now
- ;; done. Possible remaining jumps will be from
- ;; entries in the *xref* buffer and then we want to
- ;; ignore the arity. (Alternatively we could remove
- ;; all but one xref entry per file when we know the
- ;; arity).
- (setq erlang-current-arity nil)
- (point-marker)))))
-
- (defun erlang-xref-context (xref)
- (with-slots (tag-info) (xref-item-location xref)
- (car tag-info))))))
-
-
-(defun erlang-goto-tag-location-by-arity (tag-info)
- (when erlang-current-arity
- (let* ((tag-text (car tag-info))
- (tag-pos (cdr (cdr tag-info)))
- (tag-line (car (cdr tag-info)))
- (regexp (erlang-tag-info-regexp tag-text))
- (startpos (or tag-pos
- (when tag-line
- (goto-char (point-min))
- (forward-line (1- tag-line))
- (point))
- (point-min))))
- (setq startpos (max (- startpos 2000)
- (point-min)))
- (goto-char startpos)
- (let ((pos (or (erlang-search-by-arity regexp)
- (unless (eq startpos (point-min))
- (goto-char (point-min))
- (erlang-search-by-arity regexp)))))
- (when pos
- (goto-char pos)
- t)))))
-
-(defun erlang-tag-info-regexp (tag-text)
- (concat "^"
- (regexp-quote tag-text)
- ;; Erlang function entries in TAGS includes the opening
- ;; parenthesis for the argument list. Erlang macro entries
- ;; do not. Add it here in order to end up in correct
- ;; position for erlang-get-arity.
- (if (string-prefix-p "-define" tag-text)
- "\\s-*("
- "")))
-
-(defun erlang-search-by-arity (regexp)
- (let (pos)
- (while (and (null pos)
- (re-search-forward regexp nil t))
- (when (eq erlang-current-arity (save-excursion (erlang-get-arity)))
- (setq pos (point-at-bol))))
- pos))
-
-
+(when (and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ (erlang-soft-require 'eieio)
+ (erlang-soft-require 'etags))
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod etc.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point ((_backend
+ (eql erlang-etags)))
+ (if (eq this-command 'xref-find-references)
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end))
+ (thing-at-point 'symbol))
+ (erlang-id-to-string (erlang-get-identifier-at-point))))
+
+ (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier))
+
+ (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier t))
+
+ (cl-defmethod xref-backend-identifier-completion-table
+ ((_backend (eql erlang-etags)))
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (tags-completion-table)))
+
+ (defclass erlang-xref-location (xref-file-location)
+ ((arity :type fixnum :initarg :arity
+ :reader erlang-xref-location-arity))
+ :documentation "An erlang location is a file location plus arity.")
+
+ ;; This method definition only calls the superclass which is
+ ;; the default behaviour if it was not defined. It is only
+ ;; needed for "upgrade" purposes. In version 2.8.1 of
+ ;; erlang.el this method was defined differently and in case
+ ;; user switch to a new erlang.el without restarting Emacs
+ ;; this method needs to be redefined.
+ (cl-defmethod xref-location-marker ((locus erlang-xref-location))
+ (cl-call-next-method locus)))))
+
+;; If this function returns a single xref the user will jump to that
+;; directly. If two or more xrefs are returned a *xref* window is
+;; displayed and the user can choose where to jump. Hence we want to
+;; return a single xref when we are pretty sure that is where the user
+;; wants to go. Otherwise return all possible xrefs but sort them so
+;; that xrefs in the local file is first and if arity is known sort
+;; the xrefs with matching arity before others.
+
+;; Note that the arity sorting work may partly be undone later when
+;; the hits are presented in the *xref* buffer since they then will be
+;; grouped together by file. Ie when one file have one hit with
+;; correct arity and others with wrong arity these hits will be
+;; grouped together and may end up before hits with correct arity.
(defun erlang-xref-find-definitions (identifier &optional is-regexp)
(erlang-with-id (kind module name arity) identifier
- (setq erlang-current-arity arity)
(cond ((eq kind 'module)
(erlang-xref-find-definitions-module name))
+ ((eq kind 'qualified-function)
+ (erlang-xref-find-definitions-qualified-function module
+ name
+ arity
+ is-regexp))
(module
- (erlang-xref-find-definitions-module-tag module
+ (erlang-xref-find-definitions-module-tag kind
+ module
name
- (eq kind
- 'qualified-function)
+ arity
is-regexp))
(t
- (erlang-xref-find-definitions-tag kind name is-regexp)))))
+ (erlang-xref-find-definitions-tag kind name arity is-regexp)))))
(defun erlang-xref-find-definitions-module (module)
(and (fboundp 'xref-make)
@@ -5040,65 +5029,252 @@ considered first when it is time to jump to the definition.")
(setq files (cdr files))))))
(nreverse xrefs))))
-(defun erlang-visit-tags-table-buffer (cont cbuf)
- (if (< emacs-major-version 26)
- (visit-tags-table-buffer cont)
- ;; Remove this with-no-warnings when Emacs 26 is the required
- ;; version minimum.
- (with-no-warnings
- (visit-tags-table-buffer cont cbuf))))
-
-(defun erlang-xref-find-definitions-module-tag (module
+(defun erlang-xref-find-definitions-qualified-function (module
+ tag
+ arity
+ is-regexp)
+ "Find definitions of TAG in MODULE preferably with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If IS-REGEXP is non-nil then
+TAG is a regexp."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ 'qualified-function
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-sort-by-arity module-xrefs arity))))
+
+
+;; We will end up here when erlang-get-some-other-id-at-point either
+;; found module among the import statements or module is just the
+;; current local file.
+(defun erlang-xref-find-definitions-module-tag (kind
+ module
tag
- is-qualified
+ arity
is-regexp)
- "Find definitions of TAG and filter away definitions outside of
-MODULE. If IS-QUALIFIED is nil and no definitions was found inside
-the MODULE then return any definitions found outside. If
-IS-REGEXP is non-nil then TAG is a regexp."
- (and (fboundp 'etags--xref-find-definitions)
- (fboundp 'erlang-convert-xrefs)
- (let ((xrefs (erlang-convert-xrefs
- (etags--xref-find-definitions tag is-regexp)))
- xrefs-in-module)
- (dolist (xref xrefs)
- (when (string-equal module (erlang-xref-module xref))
- (push xref xrefs-in-module)))
- (cond (is-qualified xrefs-in-module)
- (xrefs-in-module xrefs-in-module)
- (t xrefs)))))
-
-(defun erlang-xref-find-definitions-tag (kind tag is-regexp)
- "Find all definitions of TAG and reorder them so that
-definitions in the currently visited file comes first."
- (and (fboundp 'etags--xref-find-definitions)
- (fboundp 'erlang-convert-xrefs)
- (let* ((current-file (and (buffer-file-name)
- (file-truename (buffer-file-name))))
- (regexp (erlang-etags-regexp kind tag is-regexp))
- (xrefs (erlang-convert-xrefs
- (etags--xref-find-definitions regexp t)))
- local-xrefs non-local-xrefs)
- (while xrefs
- (let ((xref (car xrefs)))
- (if (string-equal (erlang-xref-truename-file xref)
- current-file)
- (push xref local-xrefs)
- (push xref non-local-xrefs))
- (setq xrefs (cdr xrefs))))
- (append (reverse local-xrefs)
- (reverse non-local-xrefs)))))
+ "Find definitions of TAG preferably in MODULE and with arity ARITY.
+Return definitions outside MODULE if none are found inside. If
+IS-REGEXP is non-nil then TAG is a regexp.
+
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG)."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ kind
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs))))
+
+(defun erlang-xref-find-definitions-tag (kind
+ tag
+ arity
+ is-regexp
+ &optional xrefs)
+ "Find definitions of TAG preferably in local file and with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If no such local match was
+found then look for a matching BIF in the same way. If IS-REGEXP
+is non-nil then TAG is a regexp."
+ (let* ((regexp (erlang-etags-regexp kind tag is-regexp))
+ (xrefs (or xrefs
+ (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions regexp t))))
+ (xrefs-split (erlang-split-xrefs xrefs))
+ (local-xrefs (car xrefs-split))
+ (local-xrefs (erlang-refine-xrefs local-xrefs
+ kind
+ tag
+ is-regexp))
+ (bif-xrefs (cadr xrefs-split))
+ (other-xrefs (caddr xrefs-split)))
+ (or (erlang-single-arity-match local-xrefs arity)
+ ;; No local match, look for a matching BIF.
+ (progn
+ (setq bif-xrefs (erlang-refine-xrefs bif-xrefs
+ kind
+ tag
+ is-regexp))
+ (erlang-single-arity-match bif-xrefs arity))
+ (progn
+ (setq other-xrefs (erlang-refine-xrefs other-xrefs
+ kind
+ tag
+ is-regexp))
+ (and (null local-xrefs)
+ (null bif-xrefs)
+ ;; No local of BIF matches at all. Is there a single
+ ;; arity match among the rest?
+ (erlang-single-arity-match other-xrefs arity)))
+ (append (erlang-sort-by-arity local-xrefs arity)
+ (erlang-sort-by-arity bif-xrefs arity)
+ (erlang-sort-by-arity other-xrefs arity)))))
+
+
+(defun erlang-refine-xrefs (xrefs kind tag is-regexp)
+ (if (or (memq kind '(record module))
+ ;; No support for apropos here.
+ is-regexp
+ (erlang-too-many-files-in-xrefs xrefs))
+ xrefs
+ (when (and xrefs
+ (fboundp 'xref-item-location)
+ (fboundp 'xref-location-group)
+ (fboundp 'slot-value))
+ (let (files)
+ (cl-loop for xref in xrefs
+ for loc = (xref-item-location xref)
+ for file = (xref-location-group loc)
+ do (pushnew file files :test 'string-equal))
+ (or (cl-loop for file in files
+ append (erlang-xrefs-in-file file kind tag is-regexp))
+ ;; Failed for some reason. Pretend like it is raining and
+ ;; return the unrefined xrefs.
+ xrefs)))))
+
+(defun erlang-too-many-files-in-xrefs (xrefs)
+ (and erlang-max-files-to-visit-for-refining-xrefs
+ (let ((files-to-visit (delete-dups
+ (mapcar #'erlang-xref-truename-file
+ xrefs))))
+ (if (< (length files-to-visit)
+ erlang-max-files-to-visit-for-refining-xrefs)
+ nil
+ (message (concat "Too many hits to consider arity (see "
+ "`erlang-max-files-to-visit-for-refining-xrefs')"))
+ t))))
+
+(defun erlang-xrefs-in-file (file kind tag is-regexp)
+ (when (fboundp 'make-instance)
+ (with-current-buffer (find-file-noselect file)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((regexp (concat ; "^"
+ (erlang-etags-regexp kind tag is-regexp)
+ "\\s *("))
+ last-arity)
+ (cl-loop while (re-search-forward regexp nil t)
+ for name = (match-string-no-properties 1)
+ for arity = (save-excursion
+ (erlang-get-arity))
+ for loc = (make-instance 'erlang-xref-location
+ :file file
+ :line (line-number-at-pos)
+ :column 0
+ :arity arity)
+ for sum = (erlang-xref-summary kind name arity)
+ when (and arity
+ (not (eq arity last-arity)))
+ collect (make-instance 'xref-item
+ :summary sum
+ :location loc)
+ do (setq last-arity arity)))))))
+
+(defun erlang-xref-summary (kind tag arity)
+ (format "%s%s%s"
+ (if (memq kind '(record macro module))
+ (format "%s " kind)
+ "")
+ tag
+ (if arity (format "/%s" arity) "")))
+
+(defun erlang-single-arity-match (xrefs wanted-arity)
+ "Attempt to find one perfect match.
+
+If we have all information needed to consider arity then return a
+single perfect match or nothing. If there are more than one
+match nothing is returned.
+
+If we don't have all information needed to consider arity just
+return XREFS as is."
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let ((nr-matches 0)
+ match)
+ (while (and xrefs
+ (< nr-matches 2))
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (when (eq arity wanted-arity)
+ (setq match xref
+ nr-matches (1+ nr-matches)))
+ (setq xrefs (cdr xrefs))))
+ (when (eq nr-matches 1)
+ (list match)))
+ (when (eq (length xrefs) 1)
+ xrefs)))
+
+(defun erlang-sort-by-arity (xrefs wanted-arity)
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let (matches non-matches)
+ (while xrefs
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (push xref (if (eq arity wanted-arity)
+ matches
+ non-matches))
+ (setq xrefs (cdr xrefs))))
+ (append (reverse matches) (reverse non-matches) xrefs))
+ xrefs))
+
+(defun erlang-should-consider-arity-p (xrefs wanted-arity)
+ (and wanted-arity
+ xrefs
+ (fboundp 'erlang-xref-location-p)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-p (xref-item-location (car xrefs)))))
(defun erlang-etags-regexp (kind tag is-regexp)
- (let ((tag-regexp (if is-regexp
- tag
- (regexp-quote tag))))
- (cond ((eq kind 'record)
- (concat "-record\\s-*(\\s-*" tag-regexp))
- ((eq kind 'macro)
- (concat "-define\\s-*(\\s-*" tag-regexp))
- (t tag-regexp))))
-
+ (let ((tag-regexp (concat "\\("
+ (if is-regexp
+ tag
+ (regexp-quote tag))
+ "\\)")))
+ (concat (if is-regexp "" "^")
+ (cond ((eq kind 'record)
+ (concat "-record\\s-*(\\s-*" tag-regexp))
+ ((eq kind 'macro)
+ (concat "-define\\s-*(\\s-*" tag-regexp))
+ (t
+ tag-regexp))
+ (if is-regexp "" "\\_>"))))
+
+(defun erlang-xref-arity (xref)
+ (and (fboundp 'erlang-xref-location-arity)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-arity (xref-item-location xref))))
+
+(defun erlang-split-xrefs-on-module (xrefs module)
+ (let (local-xrefs non-local-xrefs)
+ (dolist (xref xrefs)
+ (if (string-equal (erlang-xref-module xref)
+ module)
+ (push xref local-xrefs)
+ (push xref non-local-xrefs)))
+ (cons (reverse local-xrefs)
+ (reverse non-local-xrefs))))
+
+(defun erlang-split-xrefs (xrefs)
+ (let ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ local-xrefs bif-xrefs other-xrefs)
+ (dolist (xref xrefs)
+ (cond ((string-equal (erlang-xref-truename-file xref) current-file)
+ (push xref local-xrefs))
+ ((string-equal (erlang-xref-module xref) "erlang")
+ (push xref bif-xrefs))
+ (t
+ (push xref other-xrefs))))
+ (list (reverse local-xrefs)
+ (reverse bif-xrefs)
+ (reverse other-xrefs))))
(defun erlang-xref-module (xref)
(erlang-get-module-from-file-name (erlang-xref-file xref)))
@@ -5113,7 +5289,13 @@ definitions in the currently visited file comes first."
(fboundp 'xref-item-location)
(xref-location-group (xref-item-location xref))))
-
+(defun erlang-visit-tags-table-buffer (cont cbuf)
+ (if (< emacs-major-version 26)
+ (visit-tags-table-buffer cont)
+ ;; Remove this with-no-warnings when Emacs 26 is the required
+ ;; version minimum.
+ (with-no-warnings
+ (visit-tags-table-buffer cont cbuf))))
;;;
;;; Prepare for other methods to run an Erlang slave process.
diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl
index a6d43d1816..8756a4e9b3 100644
--- a/lib/tools/test/emacs_SUITE.erl
+++ b/lib/tools/test/emacs_SUITE.erl
@@ -70,19 +70,20 @@ bif_highlight(Config) ->
check_bif_highlight(Bin, Tag, Compare) ->
- [_H,IntMatch,_T] =
+ [_H,Match,_T] =
re:split(Bin,<<"defvar ",Tag/binary,
"[^(]*\\(([^)]*)">>,[]),
- EmacsIntBifs = [list_to_atom(S) ||
- S <- string:tokens(binary_to_list(IntMatch)," '\"\n")],
+ EmacsBifs = [list_to_atom(S) ||
+ S <- string:tokens(binary_to_list(Match)," '\"\n")],
- ct:log("Emacs ~p",[EmacsIntBifs]),
- ct:log("Int ~p",[Compare]),
+ ct:log("Comparing ~s", [Tag]),
+ ct:log("Emacs ~p",[EmacsBifs]),
+ ct:log("Erlang ~p",[Compare]),
- ct:log("Diff1 ~p",[Compare -- EmacsIntBifs]),
- ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]),
- [] = Compare -- EmacsIntBifs,
- [] = EmacsIntBifs -- Compare.
+ ct:log("Only in Erlang ~p",[Compare -- EmacsBifs]),
+ ct:log("Only in Emacs ~p",[EmacsBifs -- Compare]),
+ [] = Compare -- EmacsBifs,
+ [] = EmacsBifs -- Compare.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -188,7 +189,9 @@ diff(Orig, File) ->
end.
emacs_version_ok(AcceptVer) ->
- case os:cmd("emacs --version | head -1") of
+ VersionLine = os:cmd("emacs --version | head -1"),
+ io:format("~s~n", [VersionLine]),
+ case VersionLine of
"GNU Emacs " ++ Ver ->
case string:to_float(Ver) of
{Vsn, _} when Vsn >= AcceptVer ->
diff --git a/otp_versions.table b/otp_versions.table
index cc5d331b06..37b5061519 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,4 @@
+OTP-21.3.3 : erts-10.3.2 kernel-6.3.1 stdlib-3.8.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 ssl-9.2.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 :
OTP-21.3.2 : erts-10.3.1 xmerl-1.3.20 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 ssl-9.2.1 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 :
OTP-21.3.1 : erl_interface-3.11.1 ssl-9.2.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erts-10.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.19 :
OTP-21.3 : common_test-1.17 compiler-7.3.2 crypto-4.4.1 dialyzer-3.3.2 diameter-2.2 edoc-0.10 erl_docgen-0.9 erl_interface-3.11 erts-10.3 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 kernel-6.3 mnesia-4.15.6 observer-2.9 odbc-2.12.3 public_key-1.6.5 runtime_tools-1.13.2 ssh-4.7.4 ssl-9.2 stdlib-3.8 syntax_tools-2.1.7 tools-3.1 wx-1.8.7 # asn1-5.0.8 debugger-4.2.6 eldap-1.2.6 et-1.6.4 eunit-2.3.7 jinterface-1.9.1 megaco-3.18.4 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 sasl-3.3 snmp-5.2.12 tftp-1.0.1 xmerl-1.3.19 :