1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2015-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
21%%
22
23-module(ssl_pem_cache_SUITE).
24
25-behaviour(ct_suite).
26
27-include_lib("common_test/include/ct.hrl").
28-include_lib("kernel/include/file.hrl").
29-include_lib("public_key/include/public_key.hrl").
30
31%% Callback functions
32-export([all/0,
33         groups/0,
34         init_per_suite/1,
35         end_per_suite/1,
36         init_per_group/2,
37         end_per_group/2,
38         init_per_testcase/2,
39         end_per_testcase/2]).
40
41%% Testcases
42-export([pem_cleanup/0,
43         pem_cleanup/1,
44         clear_pem_cache/0,
45         clear_pem_cache/1,
46         invalid_insert/0,
47         invalid_insert/1,
48         new_root_pem/0,
49         new_root_pem/1,
50         check_cert/3
51        ]).
52
53
54-define(CLEANUP_INTERVAL, 5000).
55
56%%--------------------------------------------------------------------
57%% Common Test interface functions -----------------------------------
58%%--------------------------------------------------------------------
59all() ->
60    [
61     pem_cleanup,
62     clear_pem_cache,
63     invalid_insert,
64     new_root_pem
65    ].
66
67groups() ->
68    [].
69
70init_per_suite(Config0) ->
71    catch crypto:stop(),
72    try crypto:start() of
73	ok ->
74	    ssl_test_lib:clean_start(),
75	    %% make rsa certs
76            ssl_test_lib:make_rsa_cert(Config0)
77    catch _:_ ->
78	    {skip, "Crypto did not start"}
79    end.
80
81end_per_suite(_Config) ->
82    application:stop(crypto).
83
84init_per_group(_GroupName, Config) ->
85    Config.
86
87end_per_group(_GroupName, Config) ->
88    Config.
89
90init_per_testcase(pem_cleanup = Case, Config) ->
91    application:load(ssl),
92    end_per_testcase(Case, Config) ,
93    application:set_env(ssl, ssl_pem_cache_clean, ?CLEANUP_INTERVAL),
94    ssl:start(),
95    ct:timetrap({minutes, 1}),
96    Config;
97init_per_testcase(_, Config) ->
98    ssl_test_lib:clean_start(),
99    ct:timetrap({seconds, 10}),
100    Config.
101
102end_per_testcase(_TestCase, Config) ->
103    ssl_test_lib:clean_env(),
104    ssl:stop(),
105    Config.
106
107%%--------------------------------------------------------------------
108%% Test Cases --------------------------------------------------------
109%%--------------------------------------------------------------------
110pem_cleanup() ->
111    [{doc, "Test pem cache invalidate mechanism"}].
112pem_cleanup(Config)when is_list(Config) ->
113    process_flag(trap_exit, true),
114    ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
115    ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
116    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
117
118    Server =
119	ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
120				   {from, self()},
121				   {mfa, {ssl_test_lib, no_result, []}},
122				   {options, ServerOpts}]),
123    Port = ssl_test_lib:inet_port(Server),
124    Client =
125	ssl_test_lib:start_client([{node, ClientNode},
126		      {port, Port}, {host, Hostname},
127				   {mfa, {ssl_test_lib, no_result, []}},
128				   {from, self()}, {options, ClientOpts}]),
129
130    Size = ssl_pkix_db:db_size(get_pem_cache()),
131    Certfile = proplists:get_value(certfile, ServerOpts),
132    {ok, FileInfo} = file:read_file_info(Certfile),
133    Time = later(),
134    ok = file:write_file_info(Certfile, FileInfo#file_info{mtime = Time}),
135    ct:sleep(2 * ?CLEANUP_INTERVAL),
136    Size1 = ssl_pkix_db:db_size(get_pem_cache()),
137    ssl_test_lib:close(Server),
138    ssl_test_lib:close(Client),
139    false = Size == Size1.
140
141clear_pem_cache() ->
142    [{doc,"Test that internal reference tabel is cleaned properly even when "
143     " the PEM cache is cleared" }].
144clear_pem_cache(Config) when is_list(Config) ->
145    {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
146    [_, _,_, _, Prop] = StatusInfo,
147    State = ssl_test_lib:state(Prop),
148    [_,{FilRefDb, _} |_] = element(5, State),
149    {Server, Client} = basic_verify_test_no_close(Config),
150    CountReferencedFiles = fun({_, -1}, Acc) ->
151				   Acc;
152			      ({_, N}, Acc) ->
153				   N + Acc
154			   end,
155
156    2 = ets:foldl(CountReferencedFiles, 0, FilRefDb),
157    ssl:clear_pem_cache(),
158    _ = sys:get_status(whereis(ssl_manager)),
159    {Server1, Client1} = basic_verify_test_no_close(Config),
160    4 =  ets:foldl(CountReferencedFiles, 0, FilRefDb),
161    ssl_test_lib:close(Server),
162    ssl_test_lib:close(Client),
163    ct:sleep(2000),
164    _ = sys:get_status(whereis(ssl_manager)),
165    2 =  ets:foldl(CountReferencedFiles, 0, FilRefDb),
166    ssl_test_lib:close(Server1),
167    ssl_test_lib:close(Client1),
168    ct:sleep(2000),
169    _ = sys:get_status(whereis(ssl_manager)),
170    0 =  ets:foldl(CountReferencedFiles, 0, FilRefDb).
171
172invalid_insert() ->
173    [{doc, "Test that insert of invalid pem does not cause empty cache entry"}].
174invalid_insert(Config)when is_list(Config) ->
175    process_flag(trap_exit, true),
176
177    ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
178    ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
179    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
180    BadClientOpts = [{cacertfile, "tmp/does_not_exist.pem"} | proplists:delete(cacertfile, ClientOpts)],
181    Server =
182	ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
183				   {from, self()},
184				   {mfa, {ssl_test_lib, no_result, []}},
185				   {options, ServerOpts}]),
186    Port = ssl_test_lib:inet_port(Server),
187    ssl_test_lib:start_client_error([{node, ClientNode},
188                               {port, Port}, {host, Hostname},
189                               {from, self()}, {options, BadClientOpts}]),
190    ssl_test_lib:close(Server),
191    1 = ssl_pkix_db:db_size(get_fileref_db()).
192
193
194new_root_pem() ->
195    [{doc, "Test that changed PEM-files on disk followed by ssl:clear_pem_cache() invalidates"
196      "trusted CA cache as well as ordinary PEM cache"}].
197new_root_pem(Config)when is_list(Config) ->
198    PrivDir = proplists:get_value(priv_dir, Config),
199    #{cert := OrgSRoot} = SRoot =
200        public_key:pkix_test_root_cert("OTP test server ROOT",  [{key, ssl_test_lib:hardcode_rsa_key(6)}]),
201
202    DerConfig = public_key:pkix_test_data(#{server_chain => #{root => SRoot,
203                                                              intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}]],
204                                                              peer =>  [{key, ssl_test_lib:hardcode_rsa_key(4)}]},
205                                            client_chain => #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}],
206                                                              intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]],
207                                                              peer =>  [{key, ssl_test_lib:hardcode_rsa_key(3)}]}}),
208
209    ClientBase = filename:join(PrivDir, "client_test"),
210    SeverBase =  filename:join(PrivDir, "server_test"),
211    PemConfig = x509_test:gen_pem_config_files(DerConfig, ClientBase, SeverBase),
212    ClientConf = proplists:get_value(client_config, PemConfig),
213    ServerConf = proplists:get_value(server_config, PemConfig),
214
215    SCAFile =  proplists:get_value(cacertfile, ServerConf),
216
217    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
218
219    %% Start a connection and keep it up for a little while, so that
220    %% it will be up when the second connection is started.
221    Server =
222	ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
223				   {from, self()},
224				   {mfa, {ssl_test_lib, no_result, []}},
225				   {options, ServerConf}]),
226    Port = ssl_test_lib:inet_port(Server),
227    Client =
228	ssl_test_lib:start_client([{node, ClientNode},
229                                   {port, Port}, {host, Hostname},
230				   {mfa, {?MODULE, check_cert, [OrgSRoot, SCAFile]}},
231				   {from, self()}, {options, [{verify, verify_peer} |ClientConf]}]),
232
233    ssl_test_lib:check_result(Client, ok),
234
235    %% Create new configuration
236    Key = ssl_test_lib:hardcode_rsa_key(1),
237    OTPCert = public_key:pkix_decode_cert(OrgSRoot, otp),
238    TBS = OTPCert#'OTPCertificate'.tbsCertificate,
239    #'RSAPrivateKey'{modulus=N, publicExponent=E} = Key,
240    Public = #'RSAPublicKey'{modulus=N, publicExponent=E},
241    Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'},
242    SPKI = #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
243                                      subjectPublicKey = Public},
244    NewCert = public_key:pkix_sign(TBS#'OTPTBSCertificate'{subjectPublicKeyInfo = SPKI}, Key),
245
246    DerConfig1 = public_key:pkix_test_data(#{server_chain =>
247                                                 #{root =>  #{cert => NewCert, key => Key},
248                                                   intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}]],
249                                                   peer => [{key, ssl_test_lib:hardcode_rsa_key(4)}]},
250                                             client_chain =>
251                                                 #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}],
252                                                   intermediates =>  [[{key, ssl_test_lib:hardcode_rsa_key(2)}]],
253                                                   peer => [{key, ssl_test_lib:hardcode_rsa_key(3)}]}}),
254
255    %% Overwrite old config files
256    _ = x509_test:gen_pem_config_files(DerConfig1, ClientBase, SeverBase),
257
258    %% Make sure chache is cleared
259    ssl:clear_pem_cache(),
260
261    Server1 =
262	ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
263				   {from, self()},
264				   {mfa, {ssl_test_lib, no_result, []}},
265				   {options, ServerConf}]),
266    Port1 = ssl_test_lib:inet_port(Server1),
267
268    %% Start second connection
269    Client1 = ssl_test_lib:start_client([{node, ClientNode},
270                                         {port, Port1}, {host, Hostname},
271                                         {from, self()},
272                                         {mfa, {?MODULE, check_cert, [NewCert, SCAFile]}},
273                                         {options, [{verify, verify_peer} | ClientConf]}]),
274    ssl_test_lib:check_result(Client1, ok),
275    ssl_test_lib:close(Server),
276    ssl_test_lib:close(Server1),
277    ssl_test_lib:close(Client),
278    ssl_test_lib:close(Client1).
279
280%%--------------------------------------------------------------------
281%% Internal funcations
282%%--------------------------------------------------------------------
283
284get_pem_cache() ->
285    {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
286    [_, _,_, _, Prop] = StatusInfo,
287    State = ssl_test_lib:state(Prop),
288    case element(5, State) of
289	[_CertDb, _FileRefDb, PemCache| _] ->
290	    PemCache;
291	_ ->
292	    undefined
293    end.
294
295get_fileref_db() ->
296    {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
297    [_, _,_, _, Prop] = StatusInfo,
298    State = ssl_test_lib:state(Prop),
299    case element(5, State) of
300	[_CertDb, {FileRefDb,_} | _] ->
301	    FileRefDb;
302	_ ->
303	    undefined
304    end.
305later()->
306    DateTime = calendar:now_to_local_time(os:timestamp()),
307    Gregorian = calendar:datetime_to_gregorian_seconds(DateTime),
308    calendar:gregorian_seconds_to_datetime(Gregorian + (2 * ?CLEANUP_INTERVAL)).
309
310basic_verify_test_no_close(Config) ->
311    ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
312    ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
313
314    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
315
316    Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
317					{from, self()},
318					{mfa, {ssl_test_lib, send_recv_result_active, []}},
319					{options, ServerOpts}]),
320    Port = ssl_test_lib:inet_port(Server),
321    Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
322					{host, Hostname},
323					{from, self()},
324					{mfa, {ssl_test_lib, send_recv_result_active, []}},
325					{options, ClientOpts}]),
326
327    ssl_test_lib:check_result(Server, ok, Client, ok),
328    {Server, Client}.
329
330
331check_cert(Socket, RootCert, File) ->
332    {ok, Cert} = ssl:peercert(Socket),
333    {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(File),
334    {ok, RootCert, _} = ssl_certificate:certificate_chain(Cert, ets:new(foo, []), Extracted, [], encoded),
335    ok.
336
337