1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-2019. 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
21-module(ssl_dist_SUITE).
22
23-behaviour(ct_suite).
24
25-include_lib("common_test/include/ct.hrl").
26-include_lib("public_key/include/public_key.hrl").
27-include("ssl_dist_test_lib.hrl").
28
29%% Common test
30-export([all/0,
31         init_per_suite/1,
32         init_per_testcase/2,
33         end_per_suite/1,
34         end_per_testcase/2
35        ]).
36
37%% Test cases
38-export([basic/0,
39         basic/1,
40         payload/0,
41         payload/1,
42         dist_port_overload/0,
43         dist_port_overload/1,
44         plain_options/0,
45         plain_options/1,
46         plain_verify_options/0,
47         plain_verify_options/1,
48         nodelay_option/0,
49         nodelay_option/1,
50         listen_port_options/0,
51         listen_port_options/1,
52         listen_options/0,
53         listen_options/1,
54         connect_options/0,
55         connect_options/1,
56         use_interface/0,
57         use_interface/1,
58         verify_fun_fail/0,
59         verify_fun_fail/1,
60         verify_fun_pass/0,
61         verify_fun_pass/1
62         ]).
63
64%% Apply export
65-export([basic_test/3,
66         payload_test/3,
67         plain_options_test/3,
68         plain_verify_options_test/3,
69         do_listen_options/2,
70         listen_options_test/3,
71         do_connect_options/2,
72         connect_options_test/3,
73         verify_fun_fail_test/3,
74         verify_fun_pass_test/3,
75         verify_pass_always/3,
76         verify_fail_always/3]).
77
78
79-define(DEFAULT_TIMETRAP_SECS, 240).
80-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000).
81
82-import(ssl_dist_test_lib,
83        [tstsrvr_format/2, send_to_tstcntrl/1,
84         apply_on_ssl_node/4, apply_on_ssl_node/2,
85         stop_ssl_node/1]).
86
87start_ssl_node_name(Name, Args) ->
88    ssl_dist_test_lib:start_ssl_node(Name, Args).
89
90%%--------------------------------------------------------------------
91%% Common Test interface functions -----------------------------------
92%%--------------------------------------------------------------------
93all() ->
94    [basic,
95     payload,
96     dist_port_overload,
97     plain_options,
98     plain_verify_options,
99     nodelay_option,
100     listen_port_options,
101     listen_options,
102     connect_options,
103     use_interface,
104     verify_fun_fail,
105     verify_fun_pass
106    ].
107
108init_per_suite(Config0) ->
109    _ = end_per_suite(Config0),
110    try crypto:start() of
111	ok ->
112	    %% Currently no ct function avilable for is_cover!
113	    case test_server:is_cover() of
114		false ->
115		    Config = add_ssl_opts_config(Config0),
116		    setup_certs(Config),
117		    Config;
118		true ->
119		    {skip, "Can not be covered"}
120	    end
121    catch _:_ ->
122	    {skip, "Crypto did not start"}
123    end.
124
125end_per_suite(_Config) ->
126    application:stop(crypto).
127
128init_per_testcase(plain_verify_options = Case, Config) when is_list(Config) ->
129    SslFlags = setup_tls_opts(Config),
130    Flags = case os:getenv("ERL_FLAGS") of
131		false ->
132		    os:putenv("ERL_FLAGS", SslFlags),
133		    "";
134		OldFlags ->
135		    os:putenv("ERL_FLAGS", OldFlags ++ " " ++ SslFlags),
136		    OldFlags
137    end,
138    common_init(Case, [{old_flags, Flags} | Config]);
139
140init_per_testcase(Case, Config) when is_list(Config) ->
141    common_init(Case, Config).
142
143common_init(Case, Config) ->
144    ct:timetrap({seconds, ?DEFAULT_TIMETRAP_SECS}),
145    [{testcase, Case}|Config].
146
147end_per_testcase(Case, Config) when is_list(Config) ->
148    Flags = proplists:get_value(old_flags, Config),
149    catch os:putenv("ERL_FLAGS", Flags),
150    common_end(Case, Config).
151
152common_end(_, _Config) ->
153    ok.
154
155%%--------------------------------------------------------------------
156%% Test Cases --------------------------------------------------------
157%%--------------------------------------------------------------------
158
159basic() ->
160    [{doc,"Test that two nodes can connect via ssl distribution"}].
161basic(Config) when is_list(Config) ->
162    gen_dist_test(basic_test, Config).
163
164%%--------------------------------------------------------------------
165payload() ->
166    [{doc,"Test that send a lot of data between the ssl distributed nodes"}].
167payload(Config) when is_list(Config) ->
168    gen_dist_test(payload_test, Config).
169
170%%--------------------------------------------------------------------
171dist_port_overload() ->
172    [{doc, "Test that TLS distribution connections can be accepted concurrently"}].
173dist_port_overload(Config) when is_list(Config) ->
174    %% Start a node, and get the port number it's listening on.
175    #node_handle{nodename = NodeName} = NH1 = start_ssl_node(Config),
176    [Name, Host] = string:lexemes(atom_to_list(NodeName), "@"),
177    {ok, NodesPorts} = apply_on_ssl_node(NH1, fun net_adm:names/0),
178    {Name, Port} = lists:keyfind(Name, 1, NodesPorts),
179    %% Run 4 connections concurrently. When TLS handshake is not concurrent,
180    %%  and with default net_setuptime of 7 seconds, only one connection per 7
181    %%  seconds is closed from server side. With concurrent accept, all 7 will
182    %%  be dropped in 7 seconds
183    RequiredConcurrency = 4,
184    Started = [connect(self(), Host, Port) || _ <- lists:seq(1, RequiredConcurrency)],
185    %% give 10 seconds (more than 7, less than 2x7 seconds)
186    Responded = barrier(RequiredConcurrency, [], erlang:system_time(millisecond) + 10000),
187    %% clean up
188    stop_ssl_node(NH1),
189    [R ! exit || R <- Responded],
190    [exit(P, kill) || P <- Started -- Responded],
191    %% Ensure some amount of concurrency was reached.
192    (length(Responded) >= RequiredConcurrency) orelse
193        ct:fail({actual, length(Responded), expected, RequiredConcurrency}),
194    success(Config).
195
196barrier(0, Responded, _Until) ->
197    Responded;
198barrier(RequiredConcurrency, Responded, Until) ->
199    Timeout = Until - erlang:system_time(millisecond),
200    receive
201        {waiting, Pid} ->
202            barrier(RequiredConcurrency - 1, [Pid | Responded], Until);
203        {error, Error} ->
204            ct:fail(Error)
205    after
206        Timeout -> Responded
207    end.
208
209connect(Control, Host, Port) ->
210    spawn(
211        fun () ->
212            case gen_tcp:connect(Host, Port, [{active, true}]) of
213                {ok, Sock} ->
214                    receive
215                        {tcp_closed, Sock} ->
216                            Control ! {waiting, self()};
217                        exit ->
218                            gen_tcp:close(Sock)
219                    end;
220                Error ->
221                    Control ! {error, Error}
222            end
223        end).
224
225%%--------------------------------------------------------------------
226plain_options() ->
227    [{doc,"Test specifying tls options not related to certificate verification"}].
228plain_options(Config) when is_list(Config) ->
229    TLSOpts = "-ssl_dist_opt server_secure_renegotiate true "
230	"client_secure_renegotiate true "
231	"server_hibernate_after 500 client_hibernate_after 500",
232    gen_dist_test(plain_options_test, [{tls_only_basic_opts, TLSOpts} | Config]).
233
234
235%%--------------------------------------------------------------------
236plain_verify_options() ->
237    [{doc,"Test specifying tls options including certificate verification options"}].
238plain_verify_options(Config) when is_list(Config) ->
239    TLSOpts = "-ssl_dist_opt server_secure_renegotiate true "
240	"client_secure_renegotiate true "
241        "server_hibernate_after 500 client_hibernate_after 500"
242	"server_reuse_sessions true client_reuse_sessions true  "
243        "server_depth 1 client_depth 1 ",
244    gen_dist_test(plain_verify_options_test, [{tls_verify_opts, TLSOpts} | Config]).
245
246%%--------------------------------------------------------------------
247nodelay_option() ->
248    [{doc,"Test specifying dist_nodelay option"}].
249nodelay_option(Config) ->
250    try
251	%% The default is 'true', so try setting it to 'false'.
252	application:set_env(kernel, dist_nodelay, false),
253	basic(Config)
254    after
255	application:unset_env(kernel, dist_nodelay)
256    end.
257%%--------------------------------------------------------------------
258
259listen_port_options() ->
260    [{doc, "Test specifying listening ports"}].
261listen_port_options(Config) when is_list(Config) ->
262    %% Start a node, and get the port number it's listening on.
263    NH1 = start_ssl_node(Config),
264    Node1 = NH1#node_handle.nodename,
265    Name1 = lists:takewhile(fun(C) -> C =/= $@ end, atom_to_list(Node1)),
266    {ok, NodesPorts} = apply_on_ssl_node(NH1, fun net_adm:names/0),
267    {Name1, Port1} = lists:keyfind(Name1, 1, NodesPorts),
268
269    %% Now start a second node, configuring it to use the same port
270    %% number.
271    PortOpt1 = "-kernel inet_dist_listen_min " ++ integer_to_list(Port1) ++
272        " inet_dist_listen_max " ++ integer_to_list(Port1),
273
274    try start_ssl_node([{tls_verify_opts, PortOpt1} | proplists:delete(tls_verify_opts, Config)]) of
275	#node_handle{} ->
276	    %% If the node was able to start, it didn't take the port
277	    %% option into account.
278	    stop_ssl_node(NH1),
279	    exit(unexpected_success)
280    catch
281	exit:{accept_failed, timeout} ->
282	    %% The node failed to start, as expected.
283	    ok
284    end,
285
286    %% Try again, now specifying a high max port.
287    PortOpt2 = "-kernel inet_dist_listen_min " ++ integer_to_list(Port1) ++
288	" inet_dist_listen_max 65535",
289    NH2 = start_ssl_node([{tls_verify_opts, PortOpt2} |  proplists:delete(tls_verify_opts, Config)]),
290
291    try
292	Node2 = NH2#node_handle.nodename,
293	Name2 = lists:takewhile(fun(C) -> C =/= $@ end, atom_to_list(Node2)),
294	{ok, NodesPorts2} = apply_on_ssl_node(NH2, fun net_adm:names/0),
295	{Name2, Port2} = lists:keyfind(Name2, 1, NodesPorts2),
296
297	%% The new port should be higher:
298	if Port2 > Port1 ->
299		ok;
300	   true ->
301		error({port, Port2, not_higher_than, Port1})
302	end
303    catch
304	_:Reason ->
305	    stop_ssl_node(NH2),
306	    stop_ssl_node(NH1),
307	    ct:fail(Reason)
308    end,
309    stop_ssl_node(NH2),
310    stop_ssl_node(NH1),
311    success(Config).
312
313%%--------------------------------------------------------------------
314listen_options() ->
315    [{doc, "Test inet_dist_listen_options"}].
316listen_options(Config) when is_list(Config) ->
317    try_setting_priority(fun do_listen_options/2, Config).
318
319%%--------------------------------------------------------------------
320connect_options() ->
321    [{doc, "Test inet_dist_connect_options"}].
322connect_options(Config) when is_list(Config) ->
323    try_setting_priority(fun do_connect_options/2, Config).
324
325
326%%--------------------------------------------------------------------
327use_interface() ->
328    [{doc, "Test inet_dist_use_interface"}].
329use_interface(Config) when is_list(Config) ->
330    %% Force the node to listen only on the loopback interface.
331    IpString = localhost_ipstr(inet_ver()),
332    Options = "-kernel inet_dist_use_interface " ++ IpString,
333
334    %% Start a node, and get the port number it's listening on.
335    NH1 = start_ssl_node([{tls_verify_opts, Options} | Config]),
336
337    try
338	Node1 = NH1#node_handle.nodename,
339	Name = lists:takewhile(fun(C) -> C =/= $@ end, atom_to_list(Node1)),
340	{ok, NodesPorts} = apply_on_ssl_node(NH1, fun net_adm:names/0),
341	{Name, Port} = lists:keyfind(Name, 1, NodesPorts),
342
343	%% Now find the socket listening on that port, and check its sockname.
344	Sockets = apply_on_ssl_node(
345		    NH1,
346		    fun() ->
347			    [inet:sockname(P) ||
348				P <- inet_ports(),
349				{ok, Port} =:= (catch inet:port(P))]
350		    end),
351	%% And check that it's actually listening on localhost.
352        IP = localhost_ip(inet_ver()),
353        [{ok,{IP,Port}}] = Sockets
354    catch
355	_:Reason ->
356	    stop_ssl_node(NH1),
357	    ct:fail(Reason)
358    end,
359    stop_ssl_node(NH1),
360    success(Config).
361%%--------------------------------------------------------------------
362verify_fun_fail() ->
363    [{doc,"Test specifying verify_fun with a function that always fails"}].
364verify_fun_fail(Config) when is_list(Config) ->
365      AddTLSVerifyOpts = "-ssl_dist_opt "
366        "server_verify_fun "
367	"\"{ssl_dist_SUITE,verify_fail_always,{}}\" "
368        "client_verify_fun "
369	"\"{ssl_dist_SUITE,verify_fail_always,{}}\" ",
370    gen_dist_test(verify_fun_fail_test, [{tls_verify_opts, AddTLSVerifyOpts} | Config]).
371
372
373%%--------------------------------------------------------------------
374verify_fun_pass() ->
375    [{doc,"Test specifying verify_fun with a function that always succeeds"}].
376verify_fun_pass(Config) when is_list(Config) ->
377    AddTLSVerifyOpts = "-ssl_dist_opt "
378        "server_verify_fun "
379	"\"{ssl_dist_SUITE,verify_pass_always,{}}\" "
380        "client_verify_fun "
381	"\"{ssl_dist_SUITE,verify_pass_always,{}}\" ",
382    gen_dist_test(verify_fun_pass_test, [{tls_verify_opts, AddTLSVerifyOpts} | Config]).
383
384%%--------------------------------------------------------------------
385%%% Internal functions -----------------------------------------------
386%%--------------------------------------------------------------------
387gen_dist_test(Test, Config) ->
388    NH1 = start_ssl_node(Config),
389    NH2 = start_ssl_node(Config),
390    try
391	?MODULE:Test(NH1, NH2, Config)
392    catch
393	_:Reason ->
394	    stop_ssl_node(NH1),
395	    stop_ssl_node(NH2),
396	    ct:fail(Reason)
397    end,
398    stop_ssl_node(NH1),
399    stop_ssl_node(NH2),
400    success(Config).
401
402%% ssl_node side api
403%%
404
405try_setting_priority(TestFun, Config) ->
406    Prio = 1,
407    case gen_udp:open(0, [{priority,Prio}]) of
408	{ok,Socket} ->
409	    case inet:getopts(Socket, [priority]) of
410		{ok,[{priority,Prio}]} ->
411		    ok = gen_udp:close(Socket),
412		    TestFun(Prio, Config);
413		_ ->
414		    ok = gen_udp:close(Socket),
415		    {skip,
416		     "Can not set priority "++integer_to_list(Prio)++
417			 " on socket"}
418	    end;
419	{error,_} ->
420	    {skip, "Can not set priority on socket"}
421    end.
422basic_test(NH1, NH2, _) ->
423    Node1 = NH1#node_handle.nodename,
424    Node2 = NH2#node_handle.nodename,
425    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
426    [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
427    [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end),
428
429    %% The test_server node has the same cookie as the ssl nodes
430    %% but it should not be able to communicate with the ssl nodes
431    %% via the erlang distribution.
432    pang = net_adm:ping(Node1),
433    pang = net_adm:ping(Node2),
434
435    %% SSL nodes should not be able to communicate with the test_server node
436    %% either (and ping should return eventually).
437    TestServer = node(),
438    pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(TestServer) end),
439    pang = apply_on_ssl_node(NH2, fun () -> net_adm:ping(TestServer) end),
440
441    %%
442    %% Check that we are able to communicate over the erlang
443    %% distribution between the ssl nodes.
444    %%
445    Ref = make_ref(),
446    spawn(fun () ->
447		  apply_on_ssl_node(
448		    NH1,
449		    fun () ->
450			    tstsrvr_format(
451                              "Hi from ~p!~n", [node()]),
452			    send_to_tstcntrl(
453                              {Ref, self()}),
454			    receive
455				{From, ping} ->
456				    tstsrvr_format(
457                                      "Received ping ~p!~n", [node()]),
458				    From ! {self(), pong}
459			    end
460		    end)
461	  end),
462     receive
463	 {Ref, SslPid} ->
464	     ok = apply_on_ssl_node(
465		    NH2,
466		    fun () ->
467			    tstsrvr_format(
468                              "Hi from ~p!~n", [node()]),
469			    SslPid ! {self(), ping},
470			    receive
471				{SslPid, pong} ->
472				    ok
473			    end
474		    end)
475     end.
476
477payload_test(NH1, NH2, _) ->
478    Node1 = NH1#node_handle.nodename,
479    Node2 = NH2#node_handle.nodename,
480
481    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
482
483    [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
484    [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end),
485
486    Ref = make_ref(),
487    spawn(fun () ->
488		  apply_on_ssl_node(
489		    NH1,
490		    fun () ->
491			    send_to_tstcntrl(
492                              {Ref, self()}),
493			    receive
494				{From, Msg} ->
495				    From ! {self(), Msg}
496			    end
497		    end)
498	  end),
499     receive
500	 {Ref, SslPid} ->
501	     ok = apply_on_ssl_node(
502		    NH2,
503		    fun () ->
504			    Msg = crypto:strong_rand_bytes(100000),
505			    SslPid ! {self(), Msg},
506			    receive
507				{SslPid, Msg} ->
508				    ok
509			    end
510		    end)
511     end.
512
513plain_options_test(NH1, NH2, _) ->
514    Node1 = NH1#node_handle.nodename,
515    Node2 = NH2#node_handle.nodename,
516
517    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
518
519    [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
520    [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end).
521
522plain_verify_options_test(NH1, NH2, _) ->
523    Node1 = NH1#node_handle.nodename,
524    Node2 = NH2#node_handle.nodename,
525
526    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
527
528    [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
529    [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end).
530
531do_listen_options(Prio, Config) ->
532    PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]",
533    PriorityString =
534	case os:cmd("echo [{a,1}]") of
535	    "[{a,1}]"++_ ->
536		PriorityString0;
537	    _ ->
538		%% Some shells need quoting of [{}]
539		"'"++PriorityString0++"'"
540	end,
541
542    Options = "-kernel inet_dist_listen_options " ++ PriorityString,
543    gen_dist_test(listen_options_test, [{prio, Prio}, {tls_only_basic_opts, Options} | Config]).
544
545listen_options_test(NH1, NH2, Config) ->
546    Prio = proplists:get_value(prio, Config),
547    Node2 = NH2#node_handle.nodename,
548    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
549
550    PrioritiesNode1 =
551	apply_on_ssl_node(NH1, fun get_socket_priorities/0),
552    PrioritiesNode2 =
553	apply_on_ssl_node(NH2, fun get_socket_priorities/0),
554
555    Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio],
556    ct:pal("Elevated1: ~p~n", [Elevated1]),
557    Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio],
558    ct:pal("Elevated2: ~p~n", [Elevated2]),
559    [_|_] = Elevated1,
560    [_|_] = Elevated2.
561
562do_connect_options(Prio, Config) ->
563    PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]",
564    PriorityString =
565	case os:cmd("echo [{a,1}]") of
566	    "[{a,1}]"++_ ->
567		PriorityString0;
568	    _ ->
569		%% Some shells need quoting of [{}]
570		"'"++PriorityString0++"'"
571	end,
572
573    Options = "-kernel inet_dist_connect_options " ++ PriorityString,
574    gen_dist_test(connect_options_test,
575		  [{prio, Prio}, {tls_only_basic_opts, Options} | Config]).
576
577connect_options_test(NH1, NH2, Config) ->
578    Prio = proplists:get_value(prio, Config),
579    Node2 = NH2#node_handle.nodename,
580
581    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
582
583    PrioritiesNode1 =
584	apply_on_ssl_node(NH1, fun get_socket_priorities/0),
585    PrioritiesNode2 =
586	apply_on_ssl_node(NH2, fun get_socket_priorities/0),
587
588    Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio],
589    ct:pal("Elevated1: ~p~n", [Elevated1]),
590    Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio],
591    ct:pal("Elevated2: ~p~n", [Elevated2]),
592    %% Node 1 will have a socket with elevated priority.
593    [_|_] = Elevated1,
594    %% Node 2 will not, since it only applies to outbound connections.
595    [] = Elevated2.
596
597
598verify_fun_fail_test(NH1, NH2, _) ->
599    Node2 = NH2#node_handle.nodename,
600
601    pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
602
603    [] = apply_on_ssl_node(NH1, fun () -> nodes() end),
604    [] = apply_on_ssl_node(NH2, fun () -> nodes() end),
605
606    %% Check that the function ran on the client node.
607    [{verify_fail_always_ran, true}] =
608        apply_on_ssl_node(NH1, fun () -> ets:tab2list(verify_fun_ran) end),
609    %% On the server node, it wouldn't run, because the server didn't
610    %% request a certificate from the client.
611    undefined =
612        apply_on_ssl_node(NH2, fun () -> ets:info(verify_fun_ran) end).
613
614verify_fun_pass_test(NH1, NH2, _) ->
615    Node1 = NH1#node_handle.nodename,
616    Node2 = NH2#node_handle.nodename,
617
618    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
619
620    [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
621    [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end),
622
623    %% Check that the function ran on the client node.
624    [{verify_pass_always_ran, true}] =
625        apply_on_ssl_node(NH1, fun () -> ets:tab2list(verify_fun_ran) end),
626    %% Check that it ran on the server node as well.  The server
627    %% requested and verified the client's certificate because we
628    %% passed fail_if_no_peer_cert.
629    [{verify_pass_always_ran, true}] =
630        apply_on_ssl_node(NH2, fun () -> ets:tab2list(verify_fun_ran) end).
631
632
633get_socket_priorities() ->
634    [Priority ||
635	{ok,[{priority,Priority}]} <-
636	    [inet:getopts(Port, [priority]) || Port <- inet_ports()]].
637
638inet_ports() ->
639     [Port || Port <- erlang:ports(),
640              element(2, erlang:port_info(Port, name)) =:= "tcp_inet"].
641
642start_ssl_node(Config) ->
643    start_ssl_node(Config, "").
644
645start_ssl_node(Config, XArgs) ->
646    Name = mk_node_name(Config),
647    App = proplists:get_value(app_opts, Config),
648    SSLOpts = setup_tls_opts(Config),
649    start_ssl_node_name(
650      Name, App ++ " " ++ SSLOpts ++ XArgs).
651
652
653mk_node_name(Config) ->
654    N = erlang:unique_integer([positive]),
655    Case = proplists:get_value(testcase, Config),
656    atom_to_list(?MODULE)
657	++ "_"
658	++ atom_to_list(Case)
659	++ "_"
660	++ integer_to_list(N).
661
662setup_certs(Config) ->
663    PrivDir = proplists:get_value(priv_dir, Config),
664    DerConfig = public_key:pkix_test_data(#{server_chain => #{root => rsa_root_key(1),
665                                                              intermediates => [rsa_intermediate(2)],
666                                                              peer => rsa_peer_key(3)},
667                                            client_chain => #{root => rsa_root_key(1),
668                                                              intermediates => [rsa_intermediate(5)],
669                                                              peer => rsa_peer_key(6)}}),
670    ClientBase = filename:join([PrivDir, "rsa"]),
671    SeverBase =  filename:join([PrivDir, "rsa"]),
672
673    _  = x509_test:gen_pem_config_files(DerConfig, ClientBase, SeverBase).
674
675setup_tls_opts(Config) ->
676    PrivDir = proplists:get_value(priv_dir, Config),
677    SC = filename:join([PrivDir, "rsa_server_cert.pem"]),
678    SK = filename:join([PrivDir, "rsa_server_key.pem"]),
679    SCA = filename:join([PrivDir, "rsa_server_cacerts.pem"]),
680    CC = filename:join([PrivDir, "rsa_client_cert.pem"]),
681    CK = filename:join([PrivDir, "rsa_client_key.pem"]),
682    CCA = filename:join([PrivDir, "rsa_client_cacerts.pem"]),
683
684    case proplists:get_value(tls_only_basic_opts, Config, []) of
685        [_|_] = BasicOpts -> %% No verify but server still need to have cert
686            "-proto_dist inet_tls " ++ "-ssl_dist_opt server_certfile " ++ SC ++ " "
687                ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " " ++ BasicOpts;
688        [] -> %% Verify
689             case proplists:get_value(tls_verify_opts, Config, []) of
690                 [_|_] ->
691                     BasicVerifyOpts = "-proto_dist inet_tls "
692                         ++ "-ssl_dist_opt server_certfile " ++ SC ++ " "
693                         ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " "
694                         ++ "-ssl_dist_opt server_cacertfile " ++ SCA ++ " "
695                         ++ "-ssl_dist_opt server_verify verify_peer "
696                         ++ "-ssl_dist_opt server_fail_if_no_peer_cert true "
697                         ++ "-ssl_dist_opt client_certfile " ++ CC ++ " "
698                         ++ "-ssl_dist_opt client_keyfile " ++ CK ++ " "
699                         ++ "-ssl_dist_opt client_cacertfile " ++ CCA ++ " "
700                         ++ "-ssl_dist_opt client_verify verify_peer ",
701                     BasicVerifyOpts ++  proplists:get_value(tls_verify_opts, Config, []);
702                 _ ->  %% No verify, no extra opts
703                     "-proto_dist inet_tls " ++ "-ssl_dist_opt server_certfile " ++ SC ++ " "
704                         ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " "
705             end
706    end.
707
708%%
709%% Start scripts etc...
710%%
711
712add_ssl_opts_config(Config) ->
713    %%
714    %% Start with boot scripts if on an installed system; otherwise,
715    %% just point out ssl ebin with -pa.
716    %%
717    try
718	Dir = proplists:get_value(priv_dir, Config),
719	LibDir = code:lib_dir(),
720	Apps = application:which_applications(),
721	{value, {stdlib, _, STDL_VSN}} = lists:keysearch(stdlib, 1, Apps),
722	{value, {kernel, _, KRNL_VSN}} = lists:keysearch(kernel, 1, Apps),
723	StdlDir = filename:join([LibDir, "stdlib-" ++ STDL_VSN]),
724	KrnlDir = filename:join([LibDir, "kernel-" ++ KRNL_VSN]),
725	{ok, _} = file:read_file_info(StdlDir),
726	{ok, _} = file:read_file_info(KrnlDir),
727	SSL_VSN = vsn(ssl),
728	VSN_CRYPTO = vsn(crypto),
729	VSN_PKEY = vsn(public_key),
730
731	SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]),
732	{ok, _} = file:read_file_info(SslDir),
733	%% We are using an installed otp system, create the boot script.
734	Script = filename:join(Dir, atom_to_list(?MODULE)),
735	{ok, RelFile} = file:open(Script ++ ".rel", [write]),
736        io:format(RelFile,
737		  "{release, ~n"
738		  " {\"SSL distribution test release\", \"~s\"},~n"
739		  " {erts, \"~s\"},~n"
740		  " [{kernel, \"~s\"},~n"
741		  "  {stdlib, \"~s\"},~n"
742		  "  {crypto, \"~s\"},~n"
743		  "  {public_key, \"~s\"},~n"
744		  "  {ssl, \"~s\"}]}.~n",
745		  [case catch erlang:system_info(otp_release) of
746		       {'EXIT', _} -> "R11B";
747		       Rel -> Rel
748		   end,
749		   erlang:system_info(version),
750		   KRNL_VSN,
751		   STDL_VSN,
752		   VSN_CRYPTO,
753		   VSN_PKEY,
754		   SSL_VSN]),
755	ok = file:close(RelFile),
756	ok = systools:make_script(Script, []),
757	[{app_opts, "-boot " ++ Script} | Config]
758    catch
759	_:_ ->
760	    [{app_opts, "-pa \"" ++ filename:dirname(code:which(ssl))++"\""}
761	     | add_comment_config(
762		 "Bootscript wasn't used since the test wasn't run on an "
763		 "installed OTP system.",
764		 Config)]
765    end.
766
767add_comment_config(Comment, []) ->
768    [{comment, Comment}];
769add_comment_config(Comment, [{comment, OldComment} | Cs]) ->
770    [{comment, Comment ++ " " ++ OldComment} | Cs];
771add_comment_config(Comment, [C|Cs]) ->
772    [C|add_comment_config(Comment, Cs)].
773
774
775success(Config) ->
776    case lists:keysearch(comment, 1, Config) of
777	{value, {comment, _} = Res} -> Res;
778	_ -> ok
779    end.
780
781vsn(App) ->
782    application:start(App),
783    try
784	{value,
785	 {ssl,
786	  _,
787	  VSN}} = lists:keysearch(App,
788				  1,
789				  application:which_applications()),
790	VSN
791     after
792	 application:stop(ssl)
793     end.
794
795verify_fail_always(_Certificate, _Event, _State) ->
796    %% Create an ETS table, to record the fact that the verify function ran.
797    %% Spawn a new process, to avoid the ETS table disappearing.
798    Parent = self(),
799    spawn(
800      fun() ->
801              catch ets:delete(verify_fun_ran),
802	      ets:new(verify_fun_ran, [public, named_table]),
803	      ets:insert(verify_fun_ran, {verify_fail_always_ran, true}),
804	      Parent ! go_ahead,
805	      timer:sleep(infinity)
806      end),
807    receive go_ahead -> ok end,
808    {fail, bad_certificate}.
809
810verify_pass_always(_Certificate, _Event, State) ->
811    %% Create an ETS table, to record the fact that the verify function ran.
812    %% Spawn a new process, to avoid the ETS table disappearing.
813    Parent = self(),
814    spawn(
815      fun() ->
816              catch ets:delete(verify_fun_ran),
817	      ets:new(verify_fun_ran, [public, named_table]),
818	      ets:insert(verify_fun_ran, {verify_pass_always_ran, true}),
819	      Parent ! go_ahead,
820	      timer:sleep(infinity)
821      end),
822    receive go_ahead -> ok end,
823    {valid, State}.
824
825localhost_ip(InetVer) ->
826    {ok, Addr} = inet:getaddr(net_adm:localhost(), InetVer),
827    Addr.
828
829localhost_ipstr(InetVer) ->
830    {ok, Addr} = inet:getaddr(net_adm:localhost(), InetVer),
831    Str = case InetVer of
832              inet ->
833                  io_lib:format("{~p,~p,~p,~p}", erlang:tuple_to_list(Addr));
834              inet6 ->
835                  io_lib:format("{~p,~p,~p,~p,~p,~p,~p,~p}", erlang:tuple_to_list(Addr))
836          end,
837    Qouted = case os:type() of
838                 {win32, _} -> Str;
839                 _ -> [$',Str,$']
840             end,
841    lists:flatten(Qouted).
842
843inet_ver() ->
844    inet.
845
846rsa_root_key(N) ->
847    %% As rsa keygen is not guaranteed to be fast
848    [{key, ssl_test_lib:hardcode_rsa_key(N)}].
849
850rsa_peer_key(N) ->
851    %% As rsa keygen is not guaranteed to be fast
852    [{key, ssl_test_lib:hardcode_rsa_key(N)}].
853
854rsa_intermediate(N) ->
855    [{key, ssl_test_lib:hardcode_rsa_key(N)}].
856
857
858