1%%%-------------------------------------------------------------------
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2017-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(ssl_bench_test_lib).
21
22-behaviour(ct_suite).
23
24%% API
25-export([setup/1]).
26
27%% Internal exports
28-export([setup_server/1]).
29
30-define(remote_host, "NETMARKS_REMOTE_HOST").
31
32setup(Name) ->
33    Host = case os:getenv(?remote_host) of
34	       false ->
35		   {ok, This} = inet:gethostname(),
36		   This;
37	       RemHost ->
38		   RemHost
39	   end,
40    Node = list_to_atom(atom_to_list(Name) ++ "@" ++ Host),
41    SlaveArgs = case init:get_argument(pa) of
42	       {ok, PaPaths} ->
43		   lists:append([" -pa " ++ P || [P] <- PaPaths]);
44	       _ -> []
45	   end,
46    %% ct:pal("Slave args: ~p~n",[SlaveArgs]),
47    Prog =
48	case os:find_executable("erl") of
49	    false -> "erl";
50	    P -> P
51	end,
52    ct:pal("Prog = ~p~n", [Prog]),
53
54    case net_adm:ping(Node) of
55	pong -> ok;
56	pang ->
57	    {ok, Node} =
58                slave:start(Host, Name, SlaveArgs, no_link, Prog)
59    end,
60    Path = code:get_path(),
61    true = rpc:call(Node, code, set_path, [Path]),
62    ok = rpc:call(Node, ?MODULE, setup_server, [node()]),
63    ct:pal("Client (~p) using ~ts~n",[node(), code:which(ssl)]),
64    (Node =:= node()) andalso restrict_schedulers(client),
65    Node.
66
67setup_server(ClientNode) ->
68    (ClientNode =:= node()) andalso restrict_schedulers(server),
69    ct:pal("Server (~p) using ~ts~n",[node(), code:which(ssl)]),
70    ok.
71
72restrict_schedulers(Type) ->
73    %% We expect this to run on 8 core machine
74    Extra0 = 1,
75    Extra =  if (Type =:= server) -> -Extra0; true -> Extra0 end,
76    Scheds = erlang:system_info(schedulers),
77    erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
78