1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2019-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%%
22-module(ssl_app_env_SUITE).
23
24-behaviour(ct_suite).
25
26-include_lib("common_test/include/ct.hrl").
27-include_lib("ssl/src/ssl_api.hrl").
28
29%% Common test
30-export([all/0,
31         groups/0,
32         init_per_suite/1,
33         init_per_group/2,
34         init_per_testcase/2,
35         end_per_suite/1,
36         end_per_group/2,
37         end_per_testcase/2
38        ]).
39
40%% Test cases
41-export([internal_active_1/0,
42         internal_active_1/1,
43         protocol_versions/0,
44         protocol_versions/1,
45         empty_protocol_versions/0,
46         empty_protocol_versions/1
47         ]).
48
49-define(TIMEOUT, {seconds, 5}).
50-define(SLEEP, 500).
51%%--------------------------------------------------------------------
52%% Common Test interface functions -----------------------------------
53%%--------------------------------------------------------------------
54
55all() ->
56    [
57     {group, 'tlsv1.3'},
58     {group, 'tlsv1.2'},
59     {group, 'tlsv1.1'},
60     {group, 'tlsv1'},
61     {group, 'dtlsv1.2'},
62     {group, 'dtlsv1'}
63    ].
64
65groups() ->
66    [
67     {'tlsv1.3', [], tests()},
68     {'tlsv1.2', [],  tests()},
69     {'tlsv1.1', [],  tests()},
70     {'tlsv1', [],  tests()},
71     {'dtlsv1.2', [], tests()},
72     {'dtlsv1', [],  tests()}
73    ].
74
75tests() ->
76    [
77     internal_active_1,
78     protocol_versions,
79     empty_protocol_versions
80    ].
81
82
83init_per_suite(Config0) ->
84    catch crypto:stop(),
85    try crypto:start() of
86	ok ->
87	    ssl_test_lib:clean_start(),
88	    ssl_test_lib:make_rsa_cert(Config0)
89    catch _:_ ->
90	    {skip, "Crypto did not start"}
91    end.
92
93end_per_suite(_Config) ->
94    ssl:stop(),
95    application:unload(ssl),
96    application:stop(crypto).
97
98init_per_group(GroupName, Config) ->
99    case ssl_test_lib:is_protocol_version(GroupName) of
100	true ->
101            ssl_test_lib:init_per_group(GroupName,
102                                        [{client_type, erlang},
103                                         {server_type, erlang},
104                                         {version, GroupName} | Config]);
105        false ->
106            Config
107    end.
108
109end_per_group(GroupName, Config) ->
110    ssl_test_lib:end_per_group(GroupName, Config).
111
112init_per_testcase(internal_active_1, Config) ->
113    Version = ssl_test_lib:protocol_version(Config),
114    ssl:stop(),
115    application:load(ssl),
116    ssl_test_lib:clean_env(),
117    application:set_env(ssl, internal_active_n, 1),
118    ssl_test_lib:set_protocol_versions(Version),
119    ssl:start(),
120    ct:timetrap(?TIMEOUT),
121    ssl_test_lib:ct_log_supported_protocol_versions(Config),
122    Config;
123init_per_testcase(protocol_versions, Config) ->
124    Version = ssl_test_lib:protocol_version(Config),
125    ssl_test_lib:set_protocol_versions(Version),
126    ssl_test_lib:ct_log_supported_protocol_versions(Config),
127    ct:timetrap(?TIMEOUT),
128    Config;
129init_per_testcase(empty_protocol_versions, Config)  ->
130    ssl:stop(),
131    application:load(ssl),
132    ssl_test_lib:clean_env(),
133    application:set_env(ssl, protocol_version, []),
134    application:set_env(ssl, dtls_protocol_version, []),
135    ssl:start(),
136    ssl_test_lib:ct_log_supported_protocol_versions(Config),
137    ct:timetrap(?TIMEOUT),
138    Config;
139init_per_testcase(_TestCase, Config) ->
140    ct:timetrap(?TIMEOUT),
141    Config.
142
143end_per_testcase(_, Config) ->
144    Config.
145
146%%--------------------------------------------------------------------
147%% Test Cases --------------------------------------------------------
148%%--------------------------------------------------------------------
149%%--------------------------------------------------------------------
150internal_active_1() ->
151    [{doc,"Test internal active 1 (behave as internal active once)"}].
152
153internal_active_1(Config) when is_list(Config) ->
154    ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
155    ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
156    ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config).
157
158%%--------------------------------------------------------------------
159protocol_versions() ->
160    [{doc,"Test to set a list of protocol versions in app environment."}].
161
162protocol_versions(Config) when is_list(Config) ->
163    ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
164    ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
165    ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config).
166
167%%--------------------------------------------------------------------
168empty_protocol_versions() ->
169    [{doc,"Test to set an empty list of protocol versions in app environment."}].
170
171empty_protocol_versions(Config) when is_list(Config) ->
172    Version = proplists:get_value(version, Config),
173    VersionsR =  ssl:versions(),
174    Supported = proplists:get_value(supported, VersionsR) ++
175        proplists:get_value(supported_dtls, VersionsR),
176    ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
177    ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
178    case lists:member(Version, Supported) of
179        true ->
180            ssl_test_lib:basic_test([{versions, [Version]} | ClientOpts], ServerOpts, Config);
181        false ->
182            ssl_test_lib:basic_alert([{versions, [Version]} | ClientOpts],
183                                     ServerOpts, Config, protocol_version)
184    end.
185