aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ssl/test
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2017-11-20 15:42:58 +0100
committerRaimo Niskanen <[email protected]>2017-12-04 14:52:28 +0100
commitd550a0339cce93e8d62f30c2d5e9ab6dd329a50e (patch)
tree526fae16ef7777d578fd6c9bf4a2f3b1cd1b0fed /lib/ssl/test
parente6be253c9968f71038347b25a157c1c01080e95f (diff)
downloadotp-d550a0339cce93e8d62f30c2d5e9ab6dd329a50e.tar.gz
otp-d550a0339cce93e8d62f30c2d5e9ab6dd329a50e.tar.bz2
otp-d550a0339cce93e8d62f30c2d5e9ab6dd329a50e.zip
Write SSL distribution benchmarks
Diffstat (limited to 'lib/ssl/test')
-rw-r--r--lib/ssl/test/Makefile6
-rw-r--r--lib/ssl/test/ssl.spec3
-rw-r--r--lib/ssl/test/ssl_bench.spec2
-rw-r--r--lib/ssl/test/ssl_bench_SUITE.erl64
-rw-r--r--lib/ssl/test/ssl_bench_test_lib.erl75
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl323
-rw-r--r--lib/ssl/test/ssl_dist_bench_SUITE.erl481
-rw-r--r--lib/ssl/test/ssl_dist_test_lib.erl343
-rw-r--r--lib/ssl/test/ssl_dist_test_lib.hrl26
9 files changed, 962 insertions, 361 deletions
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index aa01552c39..9347b56f39 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -37,6 +37,8 @@ VSN=$(GS_VSN)
MODULES = \
ssl_test_lib \
+ ssl_bench_test_lib \
+ ssl_dist_test_lib \
ssl_alpn_handshake_SUITE \
ssl_basic_SUITE \
ssl_bench_SUITE \
@@ -44,6 +46,7 @@ MODULES = \
ssl_certificate_verify_SUITE\
ssl_crl_SUITE\
ssl_dist_SUITE \
+ ssl_dist_bench_SUITE \
ssl_engine_SUITE\
ssl_handshake_SUITE \
ssl_npn_hello_SUITE \
@@ -62,7 +65,8 @@ MODULES = \
ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES =
+HRL_FILES = \
+ ssl_dist_test_lib.hrl
HRL_FILES_SRC = \
ssl_api.hrl\
diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec
index 0ad94e22bc..17b66aef40 100644
--- a/lib/ssl/test/ssl.spec
+++ b/lib/ssl/test/ssl.spec
@@ -3,3 +3,6 @@
ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple,
use_pem_cache, bypass_pem_cache],
"Benchmarks run separately"}.
+{skip_suites, "../ssl_test",
+ [ssl_dist_bench_SUITE],
+ "Benchmarks run separately"}.
diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec
index d2f75b4203..8b746c5ca9 100644
--- a/lib/ssl/test/ssl_bench.spec
+++ b/lib/ssl/test/ssl_bench.spec
@@ -1 +1 @@
-{suites,"../ssl_test",[ssl_bench_SUITE]}.
+{suites,"../ssl_test",[ssl_bench_SUITE, ssl_dist_bench_SUITE]}.
diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl
index ae2928b1c3..3fe6338d69 100644
--- a/lib/ssl/test/ssl_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_bench_SUITE.erl
@@ -40,11 +40,11 @@ end_per_group(_GroupName, _Config) ->
ok.
init_per_suite(Config) ->
- try
- Server = setup(ssl, node()),
- [{server_node, Server}|Config]
- catch _:_ ->
- {skipped, "Benchmark machines only"}
+ case node() of
+ nonode@nohost ->
+ {skipped, "Node not distributed"};
+ _ ->
+ [{server_node, ssl_bench_test_lib:setup(perf_server)}|Config]
end.
end_per_suite(_Config) ->
@@ -132,10 +132,10 @@ bypass_pem_cache(_Config) ->
ssl() ->
- test(ssl, ?COUNT, node()).
+ test(ssl, ?COUNT).
-test(Type, Count, Host) ->
- Server = setup(Type, Host),
+test(Type, Count) ->
+ Server = ssl_bench_test_lib:setup(perf_server),
(do_test(Type, setup_connection, Count * 20, 1, Server)),
(do_test(Type, setup_connection, Count, 100, Server)),
(do_test(Type, payload, Count*300, 10, Server)),
@@ -294,47 +294,6 @@ msg() ->
"asdlkjsafsdfoierwlejsdlkfjsdf">>.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-setup(_Type, nonode@nohost) ->
- exit(dist_not_enabled);
-setup(Type, _This) ->
- Host = case os:getenv(?remote_host) of
- false ->
- {ok, This} = inet:gethostname(),
- This;
- RemHost ->
- RemHost
- end,
- Node = list_to_atom("perf_server@" ++ Host),
- SlaveArgs = case init:get_argument(pa) of
- {ok, PaPaths} ->
- lists:append([" -pa " ++ P || [P] <- PaPaths]);
- _ -> []
- end,
- %% io:format("Slave args: ~p~n",[SlaveArgs]),
- Prog =
- case os:find_executable("erl") of
- false -> "erl";
- P -> P
- end,
- io:format("Prog = ~p~n", [Prog]),
-
- case net_adm:ping(Node) of
- pong -> ok;
- pang ->
- {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog)
- end,
- Path = code:get_path(),
- true = rpc:call(Node, code, set_path, [Path]),
- ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]),
- io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]),
- (Node =:= node()) andalso restrict_schedulers(client),
- Node.
-
-setup_server(_Type, ClientNode) ->
- (ClientNode =:= node()) andalso restrict_schedulers(server),
- io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]),
- ok.
-
ensure_all_started(App, Ack) ->
case application:start(App) of
@@ -358,13 +317,6 @@ setup_server_init(Type, Tc, Loop, PC) ->
unlink(Pid),
Res.
-restrict_schedulers(Type) ->
- %% We expect this to run on 8 core machine
- Extra0 = 1,
- Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end,
- Scheds = erlang:system_info(schedulers),
- erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
-
tc(Fun, Mod, Line) ->
case timer:tc(Fun) of
{_,{'EXIT',Reason}} ->
diff --git a/lib/ssl/test/ssl_bench_test_lib.erl b/lib/ssl/test/ssl_bench_test_lib.erl
new file mode 100644
index 0000000000..e5cbb911bd
--- /dev/null
+++ b/lib/ssl/test/ssl_bench_test_lib.erl
@@ -0,0 +1,75 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssl_bench_test_lib).
+
+%% API
+-export([setup/1]).
+
+%% Internal exports
+-export([setup_server/1]).
+
+-define(remote_host, "NETMARKS_REMOTE_HOST").
+
+setup(Name) ->
+ Host = case os:getenv(?remote_host) of
+ false ->
+ {ok, This} = inet:gethostname(),
+ This;
+ RemHost ->
+ RemHost
+ end,
+ Node = list_to_atom(atom_to_list(Name) ++ "@" ++ Host),
+ SlaveArgs = case init:get_argument(pa) of
+ {ok, PaPaths} ->
+ lists:append([" -pa " ++ P || [P] <- PaPaths]);
+ _ -> []
+ end,
+ %% io:format("Slave args: ~p~n",[SlaveArgs]),
+ Prog =
+ case os:find_executable("erl") of
+ false -> "erl";
+ P -> P
+ end,
+ io:format("Prog = ~p~n", [Prog]),
+
+ case net_adm:ping(Node) of
+ pong -> ok;
+ pang ->
+ {ok, Node} =
+ slave:start(Host, Name, SlaveArgs, no_link, Prog)
+ end,
+ Path = code:get_path(),
+ true = rpc:call(Node, code, set_path, [Path]),
+ ok = rpc:call(Node, ?MODULE, setup_server, [node()]),
+ io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]),
+ (Node =:= node()) andalso restrict_schedulers(client),
+ Node.
+
+setup_server(ClientNode) ->
+ (ClientNode =:= node()) andalso restrict_schedulers(server),
+ io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]),
+ ok.
+
+restrict_schedulers(Type) ->
+ %% We expect this to run on 8 core machine
+ Extra0 = 1,
+ Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end,
+ Scheds = erlang:system_info(schedulers),
+ erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
index 8740e8c8f0..c822a52d1f 100644
--- a/lib/ssl/test/ssl_dist_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,6 +22,7 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("public_key/include/public_key.hrl").
+-include("ssl_dist_test_lib.hrl").
%% Note: This directive should only be used in test suites.
-compile(export_all).
@@ -30,12 +31,12 @@
-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000).
--record(node_handle,
- {connection_handler,
- socket,
- name,
- nodename}
- ).
+-import(ssl_dist_test_lib,
+ [tstsrvr_format/2, send_to_tstcntrl/1,
+ apply_on_ssl_node/4, apply_on_ssl_node/2,
+ stop_ssl_node/1]).
+start_ssl_node_name(Name, Args) ->
+ ssl_dist_test_lib:start_ssl_node(Name, Args).
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -140,11 +141,14 @@ basic_test(NH1, NH2, _) ->
apply_on_ssl_node(
NH1,
fun () ->
- tstsrvr_format("Hi from ~p!~n", [node()]),
- send_to_tstcntrl({Ref, self()}),
+ tstsrvr_format(
+ "Hi from ~p!~n", [node()]),
+ send_to_tstcntrl(
+ {Ref, self()}),
receive
{From, ping} ->
- tstsrvr_format("Received ping ~p!~n", [node()]),
+ tstsrvr_format(
+ "Received ping ~p!~n", [node()]),
From ! {self(), pong}
end
end)
@@ -154,7 +158,8 @@ basic_test(NH1, NH2, _) ->
ok = apply_on_ssl_node(
NH2,
fun () ->
- tstsrvr_format("Hi from ~p!~n", [node()]),
+ tstsrvr_format(
+ "Hi from ~p!~n", [node()]),
SslPid ! {self(), ping},
receive
{SslPid, pong} ->
@@ -183,7 +188,8 @@ payload_test(NH1, NH2, _) ->
apply_on_ssl_node(
NH1,
fun () ->
- send_to_tstcntrl({Ref, self()}),
+ send_to_tstcntrl(
+ {Ref, self()}),
receive
{From, Msg} ->
From ! {self(), Msg}
@@ -616,12 +622,6 @@ gen_dist_test(Test, Config) ->
%% ssl_node side api
%%
-tstsrvr_format(Fmt, ArgList) ->
- send_to_tstsrvr({format, Fmt, ArgList}).
-
-send_to_tstcntrl(Message) ->
- send_to_tstsrvr({message, Message}).
-
try_setting_priority(TestFun, Config) ->
Prio = 1,
case gen_udp:open(0, [{priority,Prio}]) of
@@ -653,44 +653,6 @@ inet_ports() ->
%% test_server side api
%%
-apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
- Ref = make_ref(),
- send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}),
- receive
- {Ref, Result} ->
- Result
- end.
-
-apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) ->
- Ref = make_ref(),
- send_to_ssl_node(Node, {apply, self(), Ref, Fun}),
- receive
- {Ref, Result} ->
- Result
- end.
-
-stop_ssl_node(#node_handle{connection_handler = Handler,
- socket = Socket,
- name = Name}) ->
- ?t:format("Trying to stop ssl node ~s.~n", [Name]),
- Mon = erlang:monitor(process, Handler),
- unlink(Handler),
- case gen_tcp:send(Socket, term_to_binary(stop)) of
- ok ->
- receive
- {'DOWN', Mon, process, Handler, Reason} ->
- case Reason of
- normal ->
- ok;
- _ ->
- ct:pal("Down ~p ~n", [Reason])
- end
- end;
- Error ->
- erlang:demonitor(Mon, [flush]),
- ct:pal("Warning ~p ~n", [Error])
- end.
-
start_ssl_node(Config) ->
start_ssl_node(Config, "").
@@ -698,29 +660,8 @@ start_ssl_node(Config, XArgs) ->
Name = mk_node_name(Config),
SSL = proplists:get_value(ssl_opts, Config),
SSLDistOpts = setup_dist_opts(Config),
- start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
-
-start_ssl_node_raw(Name, Args) ->
- {ok, LSock} = gen_tcp:listen(0,
- [binary, {packet, 4}, {active, false}]),
- {ok, ListenPort} = inet:port(LSock),
- CmdLine = mk_node_cmdline(ListenPort, Name, Args),
- ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]),
- case open_port({spawn, CmdLine}, []) of
- Port when is_port(Port) ->
- unlink(Port),
- erlang:port_close(Port),
- case await_ssl_node_up(Name, LSock) of
- #node_handle{} = NodeHandle ->
- ?t:format("Ssl node ~s started.~n", [Name]),
- NodeName = list_to_atom(Name ++ "@" ++ host_name()),
- NodeHandle#node_handle{nodename = NodeName};
- Error ->
- exit({failed_to_start_node, Name, Error})
- end;
- Error ->
- exit({failed_to_start_node, Name, Error})
- end.
+ start_ssl_node_name(
+ Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) ->
[begin
@@ -739,11 +680,6 @@ cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) ->
%% command line creation
%%
-host_name() ->
- [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end,
- atom_to_list(node())),
- Host.
-
mk_node_name(Config) ->
N = erlang:unique_integer([positive]),
Case = proplists:get_value(testcase, Config),
@@ -753,225 +689,6 @@ mk_node_name(Config) ->
++ "_"
++ integer_to_list(N).
-mk_node_cmdline(ListenPort, Name, Args) ->
- Static = "-detached -noinput",
- Pa = filename:dirname(code:which(?MODULE)),
- Prog = case catch init:get_argument(progname) of
- {ok,[[P]]} -> P;
- _ -> exit(no_progname_argument_found)
- end,
- NameSw = case net_kernel:longnames() of
- false -> "-sname ";
- _ -> "-name "
- end,
- {ok, Pwd} = file:get_cwd(),
- "\"" ++ Prog ++ "\" "
- ++ Static ++ " "
- ++ NameSw ++ " " ++ Name ++ " "
- ++ "-pa " ++ Pa ++ " "
- ++ "-run application start crypto -run application start public_key "
- ++ "-eval 'net_kernel:verbose(1)' "
- ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr "
- ++ host_name() ++ " "
- ++ integer_to_list(ListenPort) ++ " "
- ++ Args ++ " "
- ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " "
- ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" "
- ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
-
-%%
-%% Connection handler test_server side
-%%
-
-await_ssl_node_up(Name, LSock) ->
- case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of
- timeout ->
- gen_tcp:close(LSock),
- ?t:format("Timeout waiting for ssl node ~s to come up~n",
- [Name]),
- timeout;
- {ok, Socket} ->
- gen_tcp:close(LSock),
- case gen_tcp:recv(Socket, 0) of
- {ok, Bin} ->
- check_ssl_node_up(Socket, Name, Bin);
- {error, closed} ->
- gen_tcp:close(Socket),
- exit({lost_connection_with_ssl_node_before_up, Name})
- end;
- {error, Error} ->
- gen_tcp:close(LSock),
- exit({accept_failed, Error})
- end.
-
-check_ssl_node_up(Socket, Name, Bin) ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- exit({bad_data_received_from_ssl_node, Name, Bin});
- {ssl_node_up, NodeName} ->
- case list_to_atom(Name++"@"++host_name()) of
- NodeName ->
- Parent = self(),
- Go = make_ref(),
- %% Spawn connection handler on test server side
- Pid = spawn_link(
- fun () ->
- receive Go -> ok end,
- tstsrvr_con_loop(Name, Socket, Parent)
- end),
- ok = gen_tcp:controlling_process(Socket, Pid),
- Pid ! Go,
- #node_handle{connection_handler = Pid,
- socket = Socket,
- name = Name};
- _ ->
- exit({unexpected_ssl_node_connected, NodeName})
- end;
- Msg ->
- exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg})
- end.
-
-send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) ->
- Hndlr ! {relay_to_ssl_node, term_to_binary(Term)},
- ok.
-
-tstsrvr_con_loop(Name, Socket, Parent) ->
- inet:setopts(Socket,[{active,once}]),
- receive
- {relay_to_ssl_node, Data} when is_binary(Data) ->
- case gen_tcp:send(Socket, Data) of
- ok ->
- ok;
- _Error ->
- gen_tcp:close(Socket),
- exit({failed_to_relay_data_to_ssl_node, Name, Data})
- end;
- {tcp, Socket, Bin} ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- exit({bad_data_received_from_ssl_node, Name, Bin});
- {format, FmtStr, ArgList} ->
- ?t:format(FmtStr, ArgList);
- {message, Msg} ->
- ?t:format("Got message ~p", [Msg]),
- Parent ! Msg;
- {apply_res, To, Ref, Res} ->
- To ! {Ref, Res};
- bye ->
- ?t:format("Ssl node ~s stopped.~n", [Name]),
- gen_tcp:close(Socket),
- exit(normal);
- Unknown ->
- exit({unexpected_message_from_ssl_node, Name, Unknown})
- end;
- {tcp_closed, Socket} ->
- gen_tcp:close(Socket),
- exit({lost_connection_with_ssl_node, Name})
- end,
- tstsrvr_con_loop(Name, Socket, Parent).
-
-%%
-%% Connection handler ssl_node side
-%%
-
-% cnct2tstsrvr() is called via command line arg -run ...
-cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) ->
- %% Spawn connection handler on ssl node side
- ConnHandler
- = spawn(fun () ->
- case catch gen_tcp:connect(Host,
- list_to_integer(Port),
- [binary,
- {packet, 4},
- {active, false}]) of
- {ok, Socket} ->
- notify_ssl_node_up(Socket),
- ets:new(test_server_info,
- [set,
- public,
- named_table,
- {keypos, 1}]),
- ets:insert(test_server_info,
- {test_server_handler, self()}),
- ssl_node_con_loop(Socket);
- Error ->
- halt("Failed to connect to test server " ++
- lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n",
- [Host, Port, Error])))
- end
- end),
- spawn(fun () ->
- Mon = erlang:monitor(process, ConnHandler),
- receive
- {'DOWN', Mon, process, ConnHandler, Reason} ->
- receive after 1000 -> ok end,
- halt("test server connection handler terminated: " ++
- lists:flatten(io_lib:format("~p", [Reason])))
- end
- end).
-
-notify_ssl_node_up(Socket) ->
- case catch gen_tcp:send(Socket,
- term_to_binary({ssl_node_up, node()})) of
- ok -> ok;
- _ -> halt("Failed to notify test server that I'm up")
- end.
-
-send_to_tstsrvr(Term) ->
- case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
- Hndlr when is_pid(Hndlr) ->
- Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
- _ ->
- receive after 200 -> ok end,
- send_to_tstsrvr(Term)
- end.
-
-ssl_node_con_loop(Socket) ->
- inet:setopts(Socket,[{active,once}]),
- receive
- {relay_to_test_server, Data} when is_binary(Data) ->
- case gen_tcp:send(Socket, Data) of
- ok ->
- ok;
- _Error ->
- gen_tcp:close(Socket),
- halt("Failed to relay data to test server")
- end;
- {tcp, Socket, Bin} ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- halt("test server sent me bad data");
- {apply, From, Ref, M, F, A} ->
- spawn_link(
- fun () ->
- send_to_tstsrvr({apply_res,
- From,
- Ref,
- (catch apply(M, F, A))})
- end);
- {apply, From, Ref, Fun} ->
- spawn_link(fun () ->
- send_to_tstsrvr({apply_res,
- From,
- Ref,
- (catch Fun())})
- end);
- stop ->
- gen_tcp:send(Socket, term_to_binary(bye)),
- gen_tcp:close(Socket),
- init:stop(),
- receive after infinity -> ok end;
- _Unknown ->
- halt("test server sent me an unexpected message")
- end;
- {tcp_closed, Socket} ->
- halt("Lost connection to test server")
- end,
- ssl_node_con_loop(Socket).
-
%%
%% Setup ssl dist info
%%
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
new file mode 100644
index 0000000000..4d27564319
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -0,0 +1,481 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssl_dist_bench_SUITE).
+
+-include_lib("common_test/include/ct_event.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%% CT meta
+-export([suite/0, all/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
+
+%% Test cases
+-export(
+ [setup/1,
+ roundtrip/1,
+ throughput_1024/1,
+ throughput_4096/1,
+ throughput_16384/1,
+ throughput_65536/1,
+ throughput_262144/1,
+ throughput_1048576/1]).
+
+%% Debug
+-export([payload/1]).
+
+%%%-------------------------------------------------------------------
+
+suite() -> [{ct_hooks, [{ts_install_cth, [{nodenames, 2}]}]}].
+
+all() -> [{group, ssl}, {group, plain}].
+
+groups() ->
+ [{ssl, all_groups()},
+ {plain, all_groups()},
+ %%
+ {setup, [{repeat, 1}], [setup]},
+ {roundtrip, [{repeat, 1}], [roundtrip]},
+ {throughput, [{repeat, 1}],
+ [throughput_1024,
+ throughput_4096,
+ throughput_16384,
+ throughput_65536,
+ throughput_262144,
+ throughput_1048576]}].
+
+all_groups() ->
+ [{group, setup},
+ {group, roundtrip},
+ {group, throughput}].
+
+init_per_suite(Config) ->
+ Digest = sha1,
+ ECCurve = secp521r1,
+ TLSVersion = 'tlsv1.2',
+ TLSCipher = {ecdhe_ecdsa,aes_128_cbc,sha256,sha256},
+ %%
+ Node = node(),
+ try
+ Node =/= nonode@nohost orelse
+ throw({skipped,"Node not distributed"}),
+ {supported, SSLVersions} =
+ lists:keyfind(supported, 1, ssl:versions()),
+ lists:member(TLSVersion, SSLVersions) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(TLSVersion)}),
+ lists:member(ECCurve, ssl:eccs(TLSVersion)) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(ECCurve)}),
+ lists:member(TLSCipher, ssl:cipher_suites()) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(TLSCipher)})
+ of
+ _ ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ %%
+ [_, HostA] = string:split(atom_to_list(Node), "@"),
+ NodeAName = ?MODULE_STRING ++ "_node_a",
+ NodeAString = NodeAName ++ "@" ++ HostA,
+ NodeAConfFile = filename:join(PrivDir, NodeAString ++ ".conf"),
+ NodeA = list_to_atom(NodeAString),
+ %%
+ ServerNode = ssl_bench_test_lib:setup(dist_server),
+ [_, HostB] = string:split(atom_to_list(ServerNode), "@"),
+ NodeBName = ?MODULE_STRING ++ "_node_b",
+ NodeBString = NodeBName ++ "@" ++ HostB,
+ NodeBConfFile = filename:join(PrivDir, NodeBString ++ ".conf"),
+ NodeB = list_to_atom(NodeBString),
+ %%
+ CertOptions =
+ [{digest, Digest},
+ {key, {namedCurve, ECCurve}}],
+ RootCert =
+ public_key:pkix_test_root_cert(
+ ?MODULE_STRING ++ " ROOT CA", CertOptions),
+ SSLConf =
+ [{verify, verify_peer},
+ {versions, [TLSVersion]},
+ {ciphers, [TLSCipher]}],
+ %%
+ write_node_conf(
+ NodeAConfFile, NodeA,
+ [{fail_if_no_peer_cert, true} | SSLConf], SSLConf,
+ CertOptions, RootCert),
+ write_node_conf(
+ NodeBConfFile, NodeB,
+ [{fail_if_no_peer_cert, true} | SSLConf], SSLConf,
+ CertOptions, RootCert),
+ %%
+ [{node_a_name, NodeAName},
+ {node_a, NodeA},
+ {node_a_dist_args,
+ "-proto_dist inet_tls "
+ "-ssl_dist_optfile " ++ NodeAConfFile ++ " "},
+ {node_b_name, NodeBName},
+ {node_b, NodeB},
+ {node_b_dist_args,
+ "-proto_dist inet_tls "
+ "-ssl_dist_optfile " ++ NodeBConfFile ++ " "},
+ {server_node, ServerNode}
+ |Config]
+ catch
+ throw:Result ->
+ Result
+ end.
+
+end_per_suite(Config) ->
+ ServerNode = proplists:get_value(server_node, Config),
+ slave:stop(ServerNode).
+
+init_per_group(ssl, Config) ->
+ [{ssl_dist, true}, {ssl_dist_prefix, "SSL"}|Config];
+init_per_group(plain, Config) ->
+ [{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config];
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, _Config) ->
+ ok.
+
+init_per_testcase(_Func, Conf) ->
+ Conf.
+
+end_per_testcase(_Func, _Conf) ->
+ ok.
+
+-define(COUNT, 400).
+
+%%%-------------------------------------------------------------------
+%%% CommonTest API helpers
+
+write_node_conf(
+ ConfFile, Node, ServerConf, ClientConf, CertOptions, RootCert) ->
+ Conf =
+ public_key:pkix_test_data(
+ #{root => RootCert,
+ peer =>
+ [{extensions,
+ [#'Extension'{
+ extnID = ?'id-ce-subjectAltName',
+ extnValue = [{dNSName, atom_to_list(Node)}],
+ critical = false}]} | CertOptions]}),
+ NodeConf =
+ [{server, ServerConf ++ Conf}, {client, ClientConf ++ Conf}],
+ {ok, Fd} = file:open(ConfFile, [write]),
+ ok = file:change_mode(ConfFile, 8#400),
+ io:format(Fd, "~p.~n", [NodeConf]),
+ ok = file:close(Fd).
+
+
+%%%-------------------------------------------------------------------
+%%% Test cases
+
+%%-----------------------
+%% Connection setup speed
+
+setup(Config) ->
+ run_nodepair_test(fun setup/5, Config).
+
+setup(A, B, Prefix, HA, HB) ->
+ Rounds = 10,
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ {SetupTime, CycleTime} =
+ ssl_apply(HA, fun () -> setup_runner(A, B, Rounds) end),
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ SetupSpeed = round((Rounds*1000000*1000) / SetupTime),
+ CycleSpeed = round((Rounds*1000000*1000) / CycleTime),
+ _ = report(Prefix++" Setup", SetupSpeed, "setups/1000s"),
+ report(Prefix++" Setup Cycle", CycleSpeed, "cycles/1000s").
+
+%% Runs on node A against rex in node B
+setup_runner(A, B, Rounds) ->
+ StartTime = start_time(),
+ SetupTime = setup_loop(A, B, 0, Rounds),
+ {microseconds(SetupTime), microseconds(elapsed_time(StartTime))}.
+
+setup_loop(_A, _B, T, 0) ->
+ T;
+setup_loop(A, B, T, N) ->
+ StartTime = start_time(),
+ [A] = rpc:block_call(B, erlang, nodes, []),
+ Time = elapsed_time(StartTime),
+ [B] = erlang:nodes(),
+ Mref = erlang:monitor(process, {rex,B}),
+ true = net_kernel:disconnect(B),
+ receive
+ {'DOWN',Mref,process,_,_} ->
+ [] = erlang:nodes(),
+ setup_loop(A, B, Time + T, N - 1)
+ end.
+
+
+%%----------------
+%% Roundtrip speed
+
+roundtrip(Config) ->
+ run_nodepair_test(fun roundtrip/5, Config).
+
+roundtrip(A, B, Prefix, HA, HB) ->
+ Rounds = 40000,
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ Time = ssl_apply(HA, fun () -> roundtrip_runner(A, B, Rounds) end),
+ [B] = ssl_apply(HA, erlang, nodes, []),
+ [A] = ssl_apply(HB, erlang, nodes, []),
+ Speed = round((Rounds*1000000) / Time),
+ report(Prefix++" Roundtrip", Speed, "pings/s").
+
+%% Runs on node A and spawns a server on node B
+roundtrip_runner(A, B, Rounds) ->
+ ClientPid = self(),
+ [A] = rpc:call(B, erlang, nodes, []),
+ ServerPid =
+ erlang:spawn(
+ B,
+ fun () -> roundtrip_server(ClientPid, Rounds) end),
+ ServerMon = erlang:monitor(process, ServerPid),
+ microseconds(
+ roundtrip_client(ServerPid, ServerMon, start_time(), Rounds)).
+
+roundtrip_server(_Pid, 0) ->
+ ok;
+roundtrip_server(Pid, N) ->
+ receive
+ N ->
+ Pid ! N,
+ roundtrip_server(Pid, N-1)
+ end.
+
+roundtrip_client(_Pid, Mon, StartTime, 0) ->
+ Time = elapsed_time(StartTime),
+ receive
+ {'DOWN', Mon, _, _, normal} ->
+ Time;
+ {'DOWN', Mon, _, _, Other} ->
+ exit(Other)
+ end;
+roundtrip_client(Pid, Mon, StartTime, N) ->
+ Pid ! N,
+ receive
+ N ->
+ roundtrip_client(Pid, Mon, StartTime, N - 1)
+ end.
+
+
+%%-----------------
+%% Throughput speed
+
+throughput_1024(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 100000, 1024)
+ end, Config).
+
+throughput_4096(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 50000, 4096)
+ end, Config).
+
+throughput_16384(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 10000, 16384)
+ end, Config).
+
+throughput_65536(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 2000, 65536)
+ end, Config).
+
+throughput_262144(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 500, 262144)
+ end, Config).
+
+throughput_1048576(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 200, 1048576)
+ end, Config).
+
+throughput(A, B, Prefix, HA, HB, Packets, Size) ->
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ Time =
+ ssl_apply(HA, fun () -> throughput_runner(A, B, Packets, Size) end),
+ [B] = ssl_apply(HA, erlang, nodes, []),
+ [A] = ssl_apply(HB, erlang, nodes, []),
+ Speed = round((Packets*Size*1000000) / (1024*Time)),
+ report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s").
+
+%% Runs on node A and spawns a server on node B
+throughput_runner(A, B, Rounds, Size) ->
+ Payload = payload(Size),
+ ClientPid = self(),
+ [A] = rpc:call(B, erlang, nodes, []),
+ ServerPid =
+ erlang:spawn(
+ B,
+ fun () -> throughput_server(ClientPid, Rounds) end),
+ ServerMon = erlang:monitor(process, ServerPid),
+ microseconds(
+ throughput_client(
+ ServerPid, ServerMon, Payload, start_time(), Rounds)).
+
+throughput_server(_Pid, 0) ->
+ ok;
+throughput_server(Pid, N) ->
+ receive
+ [N|_] ->
+ throughput_server(Pid, N-1)
+ end.
+
+throughput_client(_Pid, Mon, _Payload, StartTime, 0) ->
+ receive
+ {'DOWN', Mon, _, _, normal} ->
+ elapsed_time(StartTime);
+ {'DOWN', Mon, _, _, Other} ->
+ exit(Other)
+ end;
+throughput_client(Pid, Mon, Payload, StartTime, N) ->
+ Pid ! [N|Payload],
+ throughput_client(Pid, Mon, Payload, StartTime, N - 1).
+
+%%%-------------------------------------------------------------------
+%%% Test cases helpers
+
+run_nodepair_test(TestFun, Config) ->
+ A = proplists:get_value(node_a, Config),
+ B = proplists:get_value(node_b, Config),
+ Prefix = proplists:get_value(ssl_dist_prefix, Config),
+ HA = start_ssl_node_a(Config),
+ HB = start_ssl_node_b(Config),
+ try TestFun(A, B, Prefix, HA, HB)
+ after
+ stop_ssl_node_a(HA),
+ stop_ssl_node_b(HB, Config),
+ ok
+ end.
+
+ssl_apply(Handle, M, F, Args) ->
+ case ssl_dist_test_lib:apply_on_ssl_node(Handle, M, F, Args) of
+ {'EXIT',Reason} ->
+ error(Reason);
+ Result ->
+ Result
+ end.
+
+ssl_apply(Handle, Fun) ->
+ case ssl_dist_test_lib:apply_on_ssl_node(Handle, Fun) of
+ {'EXIT',Reason} ->
+ error(Reason);
+ Result ->
+ Result
+ end.
+
+start_ssl_node_a(Config) ->
+ Name = proplists:get_value(node_a_name, Config),
+ Args = get_node_args(node_a_dist_args, Config),
+ ssl_dist_test_lib:start_ssl_node(Name, Args).
+
+start_ssl_node_b(Config) ->
+ Name = proplists:get_value(node_b_name, Config),
+ Args = get_node_args(node_b_dist_args, Config),
+ ServerNode = proplists:get_value(server_node, Config),
+ rpc:call(
+ ServerNode, ssl_dist_test_lib, start_ssl_node, [Name, Args]).
+
+stop_ssl_node_a(HA) ->
+ ssl_dist_test_lib:stop_ssl_node(HA).
+
+stop_ssl_node_b(HB, Config) ->
+ ServerNode = proplists:get_value(server_node, Config),
+ rpc:call(ServerNode, ssl_dist_test_lib, stop_ssl_node, [HB]).
+
+get_node_args(Tag, Config) ->
+ case proplists:get_value(ssl_dist, Config) of
+ true ->
+ proplists:get_value(Tag, Config);
+ false ->
+ ""
+ end.
+
+
+
+payload(Size) ->
+ iolist_to_binary(
+ [case Size bsr 8 of
+ 0 ->
+ [];
+ Blocks ->
+ payload(Blocks, create_binary(256))
+ end | create_binary(Size band 255)]).
+%%
+payload(0, _) ->
+ [];
+payload(Blocks, Block) ->
+ Half = payload(Blocks bsr 1, Block),
+ [Half, Half |
+ if
+ Blocks band 1 =:= 1 ->
+ Block;
+ true ->
+ []
+ end].
+
+create_binary(Size) ->
+ create_binary(Size, <<>>).
+%%
+create_binary(0, Bin) ->
+ Bin;
+create_binary(Size, Bin) ->
+ NextSize = Size - 1,
+ create_binary(NextSize, <<Bin/binary, NextSize>>).
+
+start_time() ->
+ erlang:system_time().
+
+elapsed_time(StartTime) ->
+ erlang:system_time() - StartTime.
+
+microseconds(Time) ->
+ erlang:convert_time_unit(Time, native, microsecond).
+
+report(Name, Value, Unit) ->
+ ct:pal("~s: ~w ~s", [Name, Value, Unit]),
+ ct_event:notify(
+ #event{
+ name = benchmark_data,
+ data = [{value, Value}, {suite, "ssl_dist"}, {name, Name}]}),
+ {comment, term_to_string(Value) ++ " " ++ Unit}.
+
+term_to_string(Term) ->
+ unicode:characters_to_list(
+ io_lib:write(Term, [{encoding, unicode}])).
diff --git a/lib/ssl/test/ssl_dist_test_lib.erl b/lib/ssl/test/ssl_dist_test_lib.erl
new file mode 100644
index 0000000000..1b9c853fc4
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_test_lib.erl
@@ -0,0 +1,343 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ssl_dist_test_lib).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+-include("ssl_dist_test_lib.hrl").
+
+-export([tstsrvr_format/2, send_to_tstcntrl/1]).
+-export([apply_on_ssl_node/4, apply_on_ssl_node/2]).
+-export([stop_ssl_node/1, start_ssl_node/2]).
+%%
+-export([cnct2tstsrvr/1]).
+
+-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000).
+
+
+
+%% ssl_node side api
+%%
+
+tstsrvr_format(Fmt, ArgList) ->
+ send_to_tstsrvr({format, Fmt, ArgList}).
+
+send_to_tstcntrl(Message) ->
+ send_to_tstsrvr({message, Message}).
+
+
+%%
+%% test_server side api
+%%
+
+apply_on_ssl_node(
+ #node_handle{connection_handler = Hndlr} = Node,
+ M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
+ Ref = erlang:monitor(process, Hndlr),
+ apply_on_ssl_node(Node, Ref, {apply, self(), Ref, M, F, A}).
+
+apply_on_ssl_node(
+ #node_handle{connection_handler = Hndlr} = Node,
+ Fun) when is_function(Fun, 0) ->
+ Ref = erlang:monitor(process, Hndlr),
+ apply_on_ssl_node(Node, Ref, {apply, self(), Ref, Fun}).
+
+apply_on_ssl_node(Node, Ref, Msg) ->
+ send_to_ssl_node(Node, Msg),
+ receive
+ {'DOWN', Ref, process, Hndlr, Reason} ->
+ exit({handler_died, Hndlr, Reason});
+ {Ref, Result} ->
+ Result
+ end.
+
+stop_ssl_node(#node_handle{connection_handler = Handler,
+ socket = Socket,
+ name = Name}) ->
+ ?t:format("Trying to stop ssl node ~s.~n", [Name]),
+ Mon = erlang:monitor(process, Handler),
+ unlink(Handler),
+ case gen_tcp:send(Socket, term_to_binary(stop)) of
+ ok ->
+ receive
+ {'DOWN', Mon, process, Handler, Reason} ->
+ case Reason of
+ normal ->
+ ok;
+ _ ->
+ ct:pal(
+ "stop_ssl_node/1 ~s Down ~p ~n",
+ [Name,Reason])
+ end
+ end;
+ Error ->
+ erlang:demonitor(Mon, [flush]),
+ ct:pal("stop_ssl_node/1 ~s Warning ~p ~n", [Name,Error])
+ end.
+
+start_ssl_node(Name, Args) ->
+ {ok, LSock} = gen_tcp:listen(0,
+ [binary, {packet, 4}, {active, false}]),
+ {ok, ListenPort} = inet:port(LSock),
+ CmdLine = mk_node_cmdline(ListenPort, Name, Args),
+ ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]),
+ case open_port({spawn, CmdLine}, []) of
+ Port when is_port(Port) ->
+ unlink(Port),
+ erlang:port_close(Port),
+ case await_ssl_node_up(Name, LSock) of
+ #node_handle{} = NodeHandle ->
+ ?t:format("Ssl node ~s started.~n", [Name]),
+ NodeName = list_to_atom(Name ++ "@" ++ host_name()),
+ NodeHandle#node_handle{nodename = NodeName};
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end;
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end.
+
+host_name() ->
+ [_, Host] = string:split(atom_to_list(node()), "@"),
+ %% [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end,
+ %% atom_to_list(node())),
+ Host.
+
+mk_node_cmdline(ListenPort, Name, Args) ->
+ Static = "-detached -noinput",
+ Pa = filename:dirname(code:which(?MODULE)),
+ Prog = case catch init:get_argument(progname) of
+ {ok,[[P]]} -> P;
+ _ -> exit(no_progname_argument_found)
+ end,
+ NameSw = case net_kernel:longnames() of
+ false -> "-sname ";
+ _ -> "-name "
+ end,
+ {ok, Pwd} = file:get_cwd(),
+ "\"" ++ Prog ++ "\" "
+ ++ Static ++ " "
+ ++ NameSw ++ " " ++ Name ++ " "
+ ++ "-pa " ++ Pa ++ " "
+ ++ "-run application start crypto -run application start public_key "
+ ++ "-eval 'net_kernel:verbose(1)' "
+ ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr "
+ ++ host_name() ++ " "
+ ++ integer_to_list(ListenPort) ++ " "
+ ++ Args ++ " "
+ ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " "
+ ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" "
+ ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
+
+%%
+%% Connection handler test_server side
+%%
+
+await_ssl_node_up(Name, LSock) ->
+ case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of
+ {ok, Socket} ->
+ gen_tcp:close(LSock),
+ case gen_tcp:recv(Socket, 0) of
+ {ok, Bin} ->
+ check_ssl_node_up(Socket, Name, Bin);
+ {error, closed} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node_before_up, Name})
+ end;
+ {error, Error} ->
+ gen_tcp:close(LSock),
+ ?t:format("Accept failed for ssl node ~s: ~p~n", [Name,Error]),
+ exit({accept_failed, Error})
+ end.
+
+check_ssl_node_up(Socket, Name, Bin) ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin});
+ {ssl_node_up, NodeName} ->
+ case list_to_atom(Name++"@"++host_name()) of
+ NodeName ->
+ Parent = self(),
+ Go = make_ref(),
+ %% Spawn connection handler on test server side
+ Pid = spawn_link(
+ fun () ->
+ receive Go -> ok end,
+ process_flag(trap_exit, true),
+ tstsrvr_con_loop(Name, Socket, Parent)
+ end),
+ ok = gen_tcp:controlling_process(Socket, Pid),
+ Pid ! Go,
+ #node_handle{connection_handler = Pid,
+ socket = Socket,
+ name = Name};
+ _ ->
+ exit({unexpected_ssl_node_connected, NodeName})
+ end;
+ Msg ->
+ exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg})
+ end.
+
+send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) ->
+ Hndlr ! {relay_to_ssl_node, term_to_binary(Term)},
+ ok.
+
+tstsrvr_con_loop(Name, Socket, Parent) ->
+ ok = inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_ssl_node, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ exit({failed_to_relay_data_to_ssl_node, Name, Data})
+ end;
+ {tcp, Socket, Bin} ->
+ try binary_to_term(Bin) of
+ {format, FmtStr, ArgList} ->
+ ?t:format(FmtStr, ArgList);
+ {message, Msg} ->
+ ?t:format("Got message ~p", [Msg]),
+ Parent ! Msg;
+ {apply_res, To, Ref, Res} ->
+ To ! {Ref, Res};
+ bye ->
+ {error, closed} = gen_tcp:recv(Socket, 0),
+ ?t:format("Ssl node ~s stopped.~n", [Name]),
+ gen_tcp:close(Socket),
+ exit(normal);
+ Unknown ->
+ exit({unexpected_message_from_ssl_node, Name, Unknown})
+ catch
+ error : _ ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin})
+ end;
+ {tcp_closed, Socket} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node, Name});
+ {'EXIT', Parent, Reason} ->
+ exit({'EXIT', parent, Reason});
+ Unknown ->
+ exit({unknown, Unknown})
+ end,
+ tstsrvr_con_loop(Name, Socket, Parent).
+
+%%
+%% Connection handler ssl_node side
+%%
+
+% cnct2tstsrvr() is called via command line arg -run ...
+cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) ->
+ %% Spawn connection handler on ssl node side
+ ConnHandler
+ = spawn(fun () ->
+ case catch gen_tcp:connect(Host,
+ list_to_integer(Port),
+ [binary,
+ {packet, 4},
+ {active, false}]) of
+ {ok, Socket} ->
+ notify_ssl_node_up(Socket),
+ ets:new(test_server_info,
+ [set,
+ public,
+ named_table,
+ {keypos, 1}]),
+ ets:insert(test_server_info,
+ {test_server_handler, self()}),
+ ssl_node_con_loop(Socket);
+ Error ->
+ halt("Failed to connect to test server " ++
+ lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n",
+ [Host, Port, Error])))
+ end
+ end),
+ spawn(fun () ->
+ Mon = erlang:monitor(process, ConnHandler),
+ receive
+ {'DOWN', Mon, process, ConnHandler, Reason} ->
+ receive after 1000 -> ok end,
+ halt("test server connection handler terminated: " ++
+ lists:flatten(io_lib:format("~p", [Reason])))
+ end
+ end).
+
+notify_ssl_node_up(Socket) ->
+ case catch gen_tcp:send(Socket,
+ term_to_binary({ssl_node_up, node()})) of
+ ok -> ok;
+ _ -> halt("Failed to notify test server that I'm up")
+ end.
+
+send_to_tstsrvr(Term) ->
+ case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
+ Hndlr when is_pid(Hndlr) ->
+ Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
+ _ ->
+ receive after 200 -> ok end,
+ send_to_tstsrvr(Term)
+ end.
+
+ssl_node_con_loop(Socket) ->
+ inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_test_server, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ halt("Failed to relay data to test server")
+ end;
+ {tcp, Socket, Bin} ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ halt("test server sent me bad data");
+ {apply, From, Ref, M, F, A} ->
+ spawn_link(
+ fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch apply(M, F, A))})
+ end);
+ {apply, From, Ref, Fun} ->
+ spawn_link(fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch Fun())})
+ end);
+ stop ->
+ gen_tcp:send(Socket, term_to_binary(bye)),
+ init:stop(),
+ receive after infinity -> ok end;
+ _Unknown ->
+ halt("test server sent me an unexpected message")
+ end;
+ {tcp_closed, Socket} ->
+ halt("Lost connection to test server")
+ end,
+ ssl_node_con_loop(Socket).
diff --git a/lib/ssl/test/ssl_dist_test_lib.hrl b/lib/ssl/test/ssl_dist_test_lib.hrl
new file mode 100644
index 0000000000..86b9b37026
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_test_lib.hrl
@@ -0,0 +1,26 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-record(node_handle,
+ {connection_handler,
+ socket,
+ name,
+ nodename}
+ ).