File 3841-ssl-add-ssl_trace-module.patch of Package erlang

Overview Repositories Revisions Requests Users Attributes Meta

File 3841-ssl-add-ssl_trace-module.patch of Package erlang (Revision 5fabdb99534eebfde997df7f0642f69a)

Currently displaying revision 5fabdb99534eebfde997df7f0642f69a , Show latest

From a18c5de9ef7ec5faaea03d44d9b0ad076b3945db Mon Sep 17 00:00:00 2001
From: Jakub Witczak <kuba@erlang.org>
Date: Wed, 16 Nov 2022 08:22:02 +0100
Subject: [PATCH] ssl: add ssl_trace module

---
 lib/ssl/src/Makefile             |   1 +
 lib/ssl/src/ssl.app.src          |   1 +
 lib/ssl/src/ssl.erl              |  14 +
 lib/ssl/src/ssl_gen_statem.erl   |  11 +
 lib/ssl/src/ssl_trace.erl        | 403 ++++++++++++++++++++++++++++
 lib/ssl/test/Makefile            |   1 +
 lib/ssl/test/ssl_test_lib.erl    |   7 +-
 lib/ssl/test/ssl_trace_SUITE.erl | 441 +++++++++++++++++++++++++++++++
 8 files changed, 878 insertions(+), 1 deletion(-)
 create mode 100644 lib/ssl/src/ssl_trace.erl
 create mode 100644 lib/ssl/test/ssl_trace_SUITE.erl

diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 789bed5c3f..2ec093579c 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -39,6 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN)
 # ----------------------------------------------------
 
 BEHAVIOUR_MODULES= \
+	ssl_trace \
 	ssl_crl_cache_api \
 	ssl_session_cache_api
 
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 9801d0c319..d1ef18e5d9 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -75,6 +75,7 @@
 	       ssl_crl_hash_dir,
 	       %% Logging
 	       ssl_logger,
+	       ssl_trace,
 	       %% App structure
 	       ssl_app,
 	       ssl_sup,
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index f4eb51b5e2..f371307d94 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -100,6 +100,8 @@
          suite_to_str/1,
          suite_to_openssl_str/1,
          str_to_suite/1]).
+%% Tracing
+-export([handle_trace/3]).
 
 -removed({ssl_accept, '_', 
           "use ssl_handshake/1,2,3 instead"}).
@@ -2917,3 +2919,15 @@ unambiguous_path(Value) ->
         _ ->
             AbsName
     end.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+handle_trace(rle, {call, {?MODULE, listen, Args}}, Stack0) ->
+    Role = server,
+    {io_lib:format("(*~w) Args = ~W", [Role, Args, 10]), [{role, Role} | Stack0]};
+handle_trace(rle, {call, {?MODULE, connect, Args}}, Stack0) ->
+    Role = client,
+    {io_lib:format("(*~w) Args = ~W", [Role, Args, 10]), [{role, Role} | Stack0]}.
+
diff --git a/lib/ssl/src/ssl_gen_statem.erl b/lib/ssl/src/ssl_gen_statem.erl
index e470103074..596c168d43 100644
--- a/lib/ssl/src/ssl_gen_statem.erl
+++ b/lib/ssl/src/ssl_gen_statem.erl
@@ -99,6 +99,9 @@
 %% Log handling
 -export([format_status/2]).
 
+%% Tracing
+-export([handle_trace/3]).
+
 %%--------------------------------------------------------------------
 %%% Initial Erlang process setup
 %%--------------------------------------------------------------------
@@ -2220,3 +2223,11 @@ maybe_generate_client_shares(#{versions := [Version|_],
     ssl_cipher:generate_client_shares([Group]);
 maybe_generate_client_shares(_) ->
     undefined.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+handle_trace(rle,
+                 {call, {?MODULE, init, Args = [[Role | _]]}}, Stack0) ->
+    {io_lib:format("(*~w) Args = ~W", [Role, Args, 3]), [{role, Role} | Stack0]}.
diff --git a/lib/ssl/src/ssl_trace.erl b/lib/ssl/src/ssl_trace.erl
new file mode 100644
index 0000000000..c40381b78d
--- /dev/null
+++ b/lib/ssl/src/ssl_trace.erl
@@ -0,0 +1,403 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2022. 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%
+%%
+
+%%
+
+%%% Purpose:
+%%%  This module implements support for using the Erlang trace in a simple way for ssl
+%%%  tracing.
+%%%
+%%%  Begin the session with ssl_trace:start(). This will do a dbg:start() if needed and
+%%%  then dbg:p/2 to set some flags.
+%%%
+%%%  Next select trace profiles to activate: for example plain text printouts of messages
+%%%  sent or received. This is switched on and off with ssl_trace:on(TraceProfile(s)) and
+%%%  ssl_trace:off(TraceProfile(s)).  For example:
+%%%
+%%%      ssl_trace:on(rle)            -- switch on printing role traces
+%%%      ssl_trace:on([api, rle])     -- switch on printing role and api traces
+%%%      ssl_trace:on()               -- switch on all ssl trace profiles
+%%%
+%%%  To switch, use the off/0 or off/1 function in the same way, for example:
+%%%
+%%%      ssl_trace:off(api)           -- switch off api tracing, but keep all other
+%%%      ssl_trace:off()              -- switch off all ssl tracing
+%%%
+%%%  Present the trace result with some other method than the default io:format/2:
+%%%      ssl_trace:start(fun(Format,Args) ->
+%%%                        my_special( io_lib:format(Format,Args) )
+%%%                      end)
+%%%  Write to ssl_trace.txt file with budget of 1000 trace entries:
+%%%      ssl_trace:start(IoFmt, [file, {budget, 1000}])
+%%%
+-module(ssl_trace).
+
+-export([start/0, start/1, start/2, stop/0, on/0,  on/1, off/0, off/1, is_on/0,
+         is_off/0]).
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
+%% Internal apply_after:
+-export([ets_delete/2]).
+
+-behaviour(gen_server).
+-define(SERVER, ?MODULE).
+-define(CALL_TIMEOUT, 15000). % 3x the default
+-define(TRACE_BUDGET, 10000).
+-define(TRACE_FILE, "ssl_trace.txt").
+
+-record(state, {
+                file = undefined,
+                types_on = [],
+                io_device = undefined
+               }).
+
+%%%----------------------------------------------------------------
+start() -> start(fun io:format/2).
+
+start(file) ->
+    start(fun io:format/2, [file]);
+start(IoFmtFun) when is_function(IoFmtFun,2) ; is_function(IoFmtFun,3) ->
+    start(IoFmtFun, []).
+
+start(IoFmtFun, TraceOpts) when is_function(IoFmtFun,2);
+                                is_function(IoFmtFun,3);
+                                is_list(TraceOpts) ->
+    {ok, Pid} = gen_server:start({local,?SERVER}, ?MODULE, TraceOpts, []),
+    true = is_process_alive(Pid),
+    catch dbg:start(),
+    start_tracer(IoFmtFun, TraceOpts),
+    dbg:p(all, [timestamp, c]),
+    get_all_trace_profiles().
+
+stop() ->
+    try
+        dbg:stop(),
+        ok = gen_server:call(?SERVER, file_close, ?CALL_TIMEOUT),
+        gen_server:stop(?SERVER)
+    catch
+        _:_ -> ok
+    end.
+
+on() ->
+    on(get_all_trace_profiles()).
+
+on(Type) ->
+    switch(on, Type).
+
+off() ->
+    off(get_all_trace_profiles()).
+
+off(Type) ->
+    switch(off, Type).
+
+is_on() ->
+    gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT).
+
+is_off() ->
+    get_all_trace_profiles() -- is_on().
+
+%%%----------------------------------------------------------------
+init(_) ->
+    try
+        ets:new(?MODULE, [public, named_table])
+    catch
+        exit:badarg ->
+            ok
+    end,
+    {ok, #state{}}.
+
+handle_call({switch,on,Profiles}, _From, State) ->
+    [enable_profile(P) || P <- Profiles],
+    NowOn = lists:usort(Profiles ++ State#state.types_on),
+    {reply, {ok,NowOn}, State#state{types_on = NowOn}};
+handle_call({switch,off,Profiles}, _From, State) ->
+    StillOn = State#state.types_on -- Profiles,
+    [disable_profile(P) || P <- Profiles],
+    {reply, {ok,StillOn}, State#state{types_on = StillOn}};
+handle_call(get_on, _From, State) ->
+    {reply, State#state.types_on, State};
+handle_call({file_open, File}, _From, State) ->
+    {ok, IODevice} = file:open(File, [write]),
+    {reply, {ok, IODevice}, State#state{io_device = IODevice}};
+handle_call(file_close, _From, #state{io_device = IODevice} = State) ->
+    case is_pid(IODevice) of
+        true ->
+            ok = file:close(IODevice);
+        _ ->
+            ok
+    end,
+    {reply, ok, State#state{io_device = undefined}};
+handle_call(C, _From, State) ->
+    io:format('*** Unknown call: ~p~n',[C]),
+    {reply, {error,{unknown_call,C}}, State}.
+
+handle_cast({new_proc,Pid}, State) ->
+    monitor(process, Pid),
+    {noreply, State};
+handle_cast(C, State) ->
+    io:format('*** Unknown cast: ~p~n',[C]),
+    {noreply, State}.
+
+handle_info({'DOWN', _MonitorRef, process, Pid, _Info}, State) ->
+    %% Universal real-time synchronization (there might be dbg msgs in the queue to the tracer):
+    timer:apply_after(20000, ?MODULE, ets_delete, [?MODULE, Pid]),
+    {noreply, State};
+handle_info(C, State) ->
+    io:format('*** Unknown info: ~p~n',[C]),
+    {noreply, State}.
+
+%%%----------------------------------------------------------------
+get_proc_stack(Pid) when is_pid(Pid) ->
+    try ets:lookup_element(?MODULE, Pid, 2)
+    catch
+        error:badarg ->
+            %% Non-existing item
+            new_proc(Pid),
+            ets:insert(?MODULE, {Pid,[]}),
+            []
+    end.
+
+new_proc(Pid) when is_pid(Pid) ->
+    gen_server:cast(?SERVER, {new_proc,Pid}).
+
+put_proc_stack(Pid, Stack) when is_pid(Pid),
+                               is_list(Stack) ->
+    ets:insert(?MODULE, {Pid, Stack}).
+
+ets_delete(Tab, Key) ->
+    catch ets:delete(Tab, Key).
+
+start_tracer(WriteFun, TraceOpts) when is_function(WriteFun,2) ->
+    start_tracer(fun(F,A,S) -> WriteFun(F,A), S end, TraceOpts);
+start_tracer(WriteFun, TraceOpts) when is_function(WriteFun,3) ->
+    Acc0 = [{budget, proplists:get_value(budget, TraceOpts, ?TRACE_BUDGET)}],
+    Acc1 = case lists:member(file, TraceOpts) of
+               true ->
+                   [{file, ?TRACE_FILE} | Acc0];
+               _ ->
+                   Acc0
+           end,
+    start_dbg_tracer(WriteFun, Acc1).
+
+start_dbg_tracer(WriteFun, InitHandlerAcc0) when is_function(WriteFun, 3) ->
+    Handler =
+        fun(Arg, Acc0) ->
+                try_handle_trace(gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT),
+                                             Arg, WriteFun,
+                                             Acc0)
+        end,
+    InitHandlerAcc1 =
+        case proplists:get_value(file, InitHandlerAcc0) of
+            undefined ->
+                InitHandlerAcc0;
+            File ->
+                {ok, IODevice} = gen_server:call(?SERVER, {file_open, File}, ?CALL_TIMEOUT),
+                [{io_device, IODevice} | InitHandlerAcc0]
+        end,
+    dbg:tracer(process, {Handler,InitHandlerAcc1}).
+
+try_handle_trace(ProfilesOn, Arg, WriteFun0, HandlerAcc) ->
+    IODevice = proplists:get_value(io_device, HandlerAcc),
+    WriteFun =
+        case is_pid(IODevice) of
+            true ->
+                fun(Format, Args, Return) ->
+                        ok = io:format(IODevice, Format, Args),
+                        Return
+                end;
+            false ->
+                WriteFun0
+        end,
+    Budget0 = proplists:get_value(budget, HandlerAcc, 0),
+    Timestamp = trace_ts(Arg),
+    Pid = trace_pid(Arg),
+    TraceInfo = trace_info(Arg),
+    Module = trace_module(TraceInfo),
+    ProcessStack = get_proc_stack(Pid),
+    Role = proplists:get_value(role, ProcessStack, '?'),
+    Budget1 =
+        lists:foldl(
+          fun(Profile, BAcc) ->
+                  case BAcc > 1 of
+                      true ->
+                          try
+                              Module:handle_trace(Profile, TraceInfo, ProcessStack)
+                          of
+                              {skip, NewProcessStack} ->
+                                  %% Don't try to process this later
+                                  put_proc_stack(Pid, NewProcessStack),
+                                  reduce_budget(BAcc);
+                              {Txt, NewProcessStack} when is_list(Txt) ->
+                                  put_proc_stack(Pid, NewProcessStack),
+                                  write_txt(WriteFun, Timestamp, Pid,
+                                            common_prefix(TraceInfo, Role,
+                                                          Profile) ++ Txt),
+                                  reduce_budget(BAcc)
+                          catch
+                              _:_ ->
+                                  %% not processed by custom handler
+                                  BAcc
+                          end;
+                      _ ->
+                          BAcc
+                  end
+          end, Budget0, ProfilesOn),
+    %% generate default trace if was not processed by any custom handler
+    Budget2 =
+        case (Budget1 == Budget0 andalso Budget0 > 0) of
+            true ->
+                WriteFun("~.100s ~W~n",
+                         [io_lib:format("~s ~p ~s ",
+                                        [lists:flatten(Timestamp),Pid,
+                                         common_prefix(TraceInfo, Role,
+                                                       "   ")]),
+                          TraceInfo, 7], processed),
+                reduce_budget(Budget0);
+            _ ->
+                Budget1
+        end,
+    [{budget, Budget2} | proplists:delete(budget, HandlerAcc)].
+
+reduce_budget(B) when B>1 ->
+    B - 1;
+reduce_budget(_B) ->
+    0.
+
+write_txt(WriteFun, Timestamp, Pid, Txt) when is_list(Txt) ->
+    WriteFun("~s ~p ~ts~n", [Timestamp, Pid, Txt], processed).
+
+get_all_trace_profiles() ->
+    Unsorted = [Profile ||
+                   {Profile, _TraceOn, _TraceOff, _TracedFuns}
+                       <- trace_profiles()],
+    lists:usort(Unsorted).
+
+switch(X, Profile) when is_atom(Profile); is_tuple(Profile) ->
+    switch(X, [Profile]);
+switch(X, Profiles) when is_list(Profiles) ->
+    case whereis(?SERVER) of
+        undefined ->
+            start();
+        _ ->
+            ok
+    end,
+    case unknown_types(Profiles, get_all_trace_profiles(), []) of
+        [] ->
+            gen_server:call(?SERVER, {switch,X,Profiles}, ?CALL_TIMEOUT);
+        L ->
+            {error, {unknown, L}}
+    end.
+
+unknown_types([], _AllProfiles, Acc) -> Acc;
+unknown_types([Profile | Tail], AllProfiles, Acc)
+  when is_atom(Profile) ->
+    case lists:member(Profile, AllProfiles) of
+        false -> unknown_types(Tail, AllProfiles, [Profile | Acc]);
+        _ -> unknown_types(Tail, AllProfiles, Acc)
+    end;
+unknown_types([ModProfile = {_Mod, Profile} | Tail], AllProfiles, Acc)
+  when is_tuple(ModProfile) ->
+    unknown_types([Profile | Tail], AllProfiles, Acc).
+
+%%%----------------------------------------------------------------
+%%% Format of trace messages are described in reference manual for erlang:trace/4
+%%%   {call,MFA}
+%%%   {return_from,{M,F,N},Result}
+%%%   {send,Msg,To}
+%%%   {'receive',Msg}
+
+%% Pick 2nd element, the Pid
+trace_pid(T) when element(1,T)==trace
+                  ; element(1,T)==trace_ts ->
+    element(2,T).
+
+%% Pick last element, the Time Stamp, and format it
+trace_ts(T) when  element(1,T)==trace_ts ->
+    ts( element(size(T), T) ).
+
+ts({_,_,Usec}=Now) when is_integer(Usec) ->
+    {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
+    io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
+ts(_) ->
+    "-".
+
+%% Make a tuple of all elements but the 1st, 2nd and last
+trace_info(T) ->
+    case tuple_to_list(T) of
+        [trace,_Pid | Info] -> list_to_tuple(Info);
+        [trace_ts,_Pid | InfoTS] -> list_to_tuple(
+                                      lists:droplast(InfoTS))
+    end.
+
+trace_module(Info) ->
+    {Module, _, _} = element(2, Info),
+    Module.
+
+common_prefix({call, {M, F, Args}}, Role, Profile) ->
+    [io_lib:format("~s (~w) -> ~w:~w/~w ",
+                   [Profile, Role, M, F, length(Args)])];
+common_prefix({return_from, {M, F, Arity}, _Return}, Role, Profile) ->
+    [io_lib:format("~s (~w) <- ~w:~w/~w returned ",
+                   [Profile, Role, M, F, Arity])];
+common_prefix({exception_from, {M, F, Arity}, Reason}, Role, Profile) ->
+    [io_lib:format("~s (~w) exception_from ~w:~w/~w  ~w",
+                   [Profile, Role, M, F, Arity, Reason])];
+common_prefix(_E, _Role, _Profile) ->
+    [].
+
+enable_profile(Profile) when is_atom(Profile) ->
+    [enable_profile({M, Profile}) || M <- modules(Profile)];
+enable_profile({Module, Profile}) when is_atom(Module); is_atom(Profile) ->
+    {Profile, TraceOn, _, AllFuns} = profile(Profile),
+    Funs = proplists:get_value(Module, AllFuns),
+    process_profile(Module, TraceOn, Funs).
+
+disable_profile(Profile) when is_atom(Profile) ->
+    [disable_profile({M, Profile}) || M <- modules(Profile)];
+disable_profile({Module, Profile}) when is_atom(Module); is_atom(Profile) ->
+    {Profile, _, TraceOff, AllFuns} = profile(Profile),
+    Funs = proplists:get_value(Module, AllFuns),
+    process_profile(Module, TraceOff, Funs).
+
+process_profile(Module, Action, Funs) when is_atom(Module) ->
+    [Action(Module, F, A) || {F, A} <- Funs].
+
+profile(P) ->
+    lists:keyfind(P, 1, trace_profiles()).
+
+modules(P) ->
+    {_, _, _, Funs} = profile(P),
+    proplists:get_keys(Funs).
+
+trace_profiles() ->
+    [{api,
+      fun(M, F, A) -> dbg:tpl(M, F, A, x) end,
+      fun(M, F, A) -> dbg:ctpl(M, F, A) end,
+      [{ssl,
+        [{listen,2}, {connect,3}, {handshake,2}, {close, 1}]},
+       {ssl_gen_statem,
+        [{initial_hello,3}, {connect, 8}, {close, 2}, {terminate_alert, 1}]}
+      ]},
+     {rle, %%role
+      fun(M, F, A) -> dbg:tpl(M, F, A, x) end,
+      fun(M, F, A) -> dbg:ctpl(M, F, A) end,
+      [{ssl, [{listen,2}, {connect,3}]},
+       {ssl_gen_statem, [{init, 1}]},
+       {tls_server_session_ticket, [{init,1}]}]}
+    ].
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index ac1318bd14..ddbc3a7c25 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -79,6 +79,7 @@ MODULES = \
 	ssl_session_cache_SUITE	\
 	ssl_session_cache_api_SUITE\	\
 	ssl_session_ticket_SUITE \
+	ssl_trace_SUITE \
 	openssl_session_ticket_SUITE \
 	openssl_session_SUITE \
 	ssl_ECC_SUITE \
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 8e7bef1098..b48cf916a4 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -213,7 +213,8 @@
          portable_cmd/2,
          portable_open_port/2,
          close_port/1,
-         verify_early_data/1
+         verify_early_data/1,
+         trace/0
         ]).
 
 -record(sslsocket, { fd = nil, pid = nil}).
@@ -4063,3 +4064,7 @@ curve_default(eddsa) ->
     ed25519;
 curve_default(_) ->
     ?DEFAULT_CURVE.
+
+trace() ->
+    ssl_trace:start(fun ct:pal/2, []),
+    ssl_trace:on().
diff --git a/lib/ssl/test/ssl_trace_SUITE.erl b/lib/ssl/test/ssl_trace_SUITE.erl
new file mode 100644
index 0000000000..7e64c9cb2e
--- /dev/null
+++ b/lib/ssl/test/ssl_trace_SUITE.erl
@@ -0,0 +1,441 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2022. 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_trace_SUITE).
+
+-include("ssl_test_lib.hrl").
+-include_lib("common_test/include/ct.hrl").
+-include_lib("ssl/src/ssl_api.hrl").
+
+-export([suite/0,
+         all/0,
+         init_per_suite/1,
+         end_per_suite/1,
+         init_per_testcase/2,
+         end_per_testcase/2]).
+
+-export([tc_basic/0,
+         tc_basic/1,
+         tc_no_trace/0,
+         tc_no_trace/1,
+         tc_api_profile/0,
+         tc_api_profile/1,
+         tc_rle_profile/0,
+         tc_rle_profile/1,
+         tc_budget_option/0,
+         tc_budget_option/1,
+         tc_file_option/0,
+         tc_file_option/1]).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+suite() -> [{ct_hooks,[ts_install_cth]},
+            {timetrap,{seconds,60}}].
+
+all() -> [tc_basic, tc_no_trace, tc_api_profile, tc_rle_profile,
+         tc_budget_option, tc_file_option].
+
+init_per_suite(Config) ->
+    catch crypto:stop(),
+    try crypto:start() of
+	ok ->
+	    ssl_test_lib:clean_start(),
+            ssl_test_lib:make_rsa_cert(Config)
+    catch _:_ ->
+	    {skip, "Crypto did not start"}
+    end.
+
+end_per_suite(_Config) ->
+    ssl:stop(),
+    application:stop(crypto).
+
+init_per_testcase(_TC, Config) ->
+    Config.
+
+end_per_testcase(_TC, Config) ->
+    ssl_trace:stop(),
+    Config.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+tc_basic() ->
+    [{doc, "Basic test of ssl_trace API"}].
+tc_basic(_Config) ->
+    L0 = ssl_trace:start(),
+    true = is_pid(whereis(ssl_trace)),
+    true = is_list(L0),
+    {ok,L0} = ssl_trace:on(),
+    {ok,L0} = ssl_trace:on(),
+    L0 = ssl_trace:is_on(),
+    [] = ssl_trace:is_off(),
+
+    L1 = [hd(L0)],
+    L2 = tl(L0),
+    {ok,L1} = ssl_trace:off(L2),
+
+    L1 = ssl_trace:is_on(),
+    L2 = ssl_trace:is_off(),
+
+    {ok,[]} = ssl_trace:off(),
+    {ok,[]} = ssl_trace:off(),
+
+    [] = ssl_trace:is_on(),
+    L0 = ssl_trace:is_off(),
+    ok = ssl_trace:stop(),
+    undefined = whereis(ssl_trace),
+
+    [api, rle] = ssl_trace:start(),
+    {ok, [api]} = ssl_trace:on(api),
+    {ok, []} = ssl_trace:off(api),
+    ok = ssl_trace:stop(),
+    ok.
+
+tc_no_trace() ->
+    [{doc, "Verify there are no traces if not enabled"}].
+
+tc_no_trace(Config) ->
+    Ref = ssl_trace_start(),
+    [Server, Client] = ssl_connect(Config),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client),
+    ExpectedTraces =
+        #{call => [], processed => [], exception_from => [], return_from => []},
+    ExpectedTraces = receive_map(Ref),
+    ok = ssl_trace:stop(),
+    ok.
+
+tc_api_profile() ->
+    [{doc, "Verify traces for 'api' trace profile"}].
+
+tc_api_profile(Config) ->
+    On = [api, rle],
+    Off = [],
+    TracesAfterConnect =
+        #{
+          call =>
+              [{"    (server) -> ssl:handshake/2", ssl, handshake},
+               {"    (client) -> ssl_gen_statem:connect/8", ssl_gen_statem, connect},
+               {"    (server) -> ssl_gen_statem:initial_hello/3",
+                ssl_gen_statem, initial_hello},
+               {"    (client) -> ssl_gen_statem:initial_hello/3",
+                ssl_gen_statem, initial_hello}],
+         return_from =>
+              [{"    (server) <- ssl:listen/2 returned", ssl, listen},
+               {"    (server) <- ssl_gen_statem:initial_hello/3 returned",
+                ssl_gen_statem, initial_hello},
+               {"    (client) <- ssl_gen_statem:initial_hello/3 returned",
+                ssl_gen_statem, initial_hello},
+               {"    (client) <- ssl_gen_statem:connect/8 returned",
+                ssl_gen_statem, connect},
+               {"    (client) <- ssl:connect/3 returned", ssl, connect},
+               {"    (server) <- ssl:handshake/2 returned", ssl, handshake}
+              ],
+          processed =>
+              ["rle ('?') -> ssl_gen_statem:init/1 (*client)",
+               "rle ('?') -> ssl_gen_statem:init/1 (*server)",
+               "rle ('?') -> ssl:listen/2 (*server) Args",
+               "rle ('?') -> ssl:connect/3 (*client) Args"]},
+    TracesAfterDisconnect =
+        #{
+          call =>
+              [{"    (client) -> ssl:close/1", ssl, close},
+               {"    (client) -> ssl:close/1", ssl, close},
+               {"    (client) -> ssl_gen_statem:close/2", ssl_gen_statem, close},
+               {"    (client) -> ssl_gen_statem:terminate_alert/1",
+                ssl_gen_statem, terminate_alert},
+               {"    (server) -> ssl:close/1", ssl, close},
+               {"    (server) -> ssl_gen_statem:close/2", ssl_gen_statem, close},
+               {"    (server) -> ssl_gen_statem:terminate_alert/1",
+                ssl_gen_statem, terminate_alert}],
+         return_from =>
+              [{"    (client) <- ssl:close/1 returned", ssl, close},
+               {"    (client) <- ssl:close/1 returned", ssl, close},
+               {"    (client) <- ssl_gen_statem:close/2 returned",
+                ssl_gen_statem, close},
+               {"    (client) <- ssl_gen_statem:terminate_alert/1 returned",
+                ssl_gen_statem, terminate_alert},
+               {"    (server) <- ssl:close/1 returned", ssl, close},
+               {"    (server) <- ssl_gen_statem:close/2 returned",
+                ssl_gen_statem, close},
+               {"    (server) <- ssl_gen_statem:terminate_alert/1 returned",
+                ssl_gen_statem, terminate_alert}],
+          exception_from =>
+              [{"    (server) exception_from ssl_gen_statem:init/1  {exit,{shutdown,normal}}",
+                ssl_gen_statem, init},
+               {"    (client) exception_from ssl_gen_statem:init/1  {exit,{shutdown,normal}}",
+                ssl_gen_statem, init}]},
+    Ref = ssl_trace_start(),
+    {ok, On} = ssl_trace:on(On),
+    Delta = On -- Off,
+    {ok, Delta} = ssl_trace:off(Off),
+    [Server, Client] = ssl_connect(Config),
+    UnhandledTraceCnt1 =
+        #{call => 0, processed => 0, exception_from => no_trace_received,
+          return_from => 0},
+    check_trace_map(Ref, TracesAfterConnect, UnhandledTraceCnt1),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client),
+    UnhandledTraceCnt2 =
+        #{call => 0, processed => no_trace_received, exception_from => 0,
+          return_from => 0},
+    check_trace_map(Ref, TracesAfterDisconnect, UnhandledTraceCnt2),
+    ssl_trace:stop(),
+    ok.
+
+tc_rle_profile() ->
+    [{doc, "Verify traces for 'rle' trace profile"}].
+
+tc_rle_profile(Config) ->
+    On = [rle],
+    ExpectedTraces =
+        #{
+          call =>
+              [],
+         return_from =>
+              [{"    (client) <- ssl:connect/3 returned", ssl, connect},
+               {"    (server) <- ssl:listen/2 returned", ssl, listen}],
+          processed =>
+              ["rle ('?') -> ssl:listen/2 (*server) Args =",
+               "rle ('?') -> ssl:connect/3 (*client) Args",
+               "rle ('?') -> ssl_gen_statem:init/1 (*server) Args = [[server",
+               "rle ('?') -> ssl_gen_statem:init/1 (*client) Args = [[client"]},
+    Ref = ssl_trace_start(),
+    {ok, On} = ssl_trace:on(On),
+    [Server, Client] = ssl_connect(Config),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client),
+    UnhandledTraceCnt =
+        #{call => no_trace_received, processed => 0, exception_from => 2,
+          return_from => 0},
+    check_trace_map(Ref, ExpectedTraces, UnhandledTraceCnt),
+    ssl_trace:stop(),
+    ok.
+
+tc_budget_option() ->
+    [{doc, "Verify that budget option limits amount of traces"}].
+
+tc_budget_option(Config) ->
+    Ref = ssl_trace_start(make_ref(), [{budget, 10}]),
+    {ok, [api,rle]} = ssl_trace:on([api,rle]),
+    [Server, Client] = ssl_connect(Config),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client),
+    CountReceived = fun(Reference) ->
+                            ReceiveStats = check_trace_map(Reference, #{}),
+                            ReceivedNumbers =
+                                lists:filter(fun is_number/1,
+                                             maps:values(ReceiveStats)),
+                            lists:sum(ReceivedNumbers)
+                    end,
+    ssl_trace:stop(),
+    ExpectedTraceCnt = 10,
+    ActualTraceCnt = CountReceived(Ref),
+    case ExpectedTraceCnt == ActualTraceCnt of
+        true ->
+            ok;
+        _ ->
+            ?FAIL("Expected ~w traces, but found ~w",
+                  [ExpectedTraceCnt, ActualTraceCnt])
+    end.
+
+tc_file_option() ->
+    [{doc, "Verify that file option redirects traces to file"}].
+
+tc_file_option(Config) ->
+    _Ref = ssl_trace_start(make_ref(), [{budget, 10}, file]),
+    {ok, [api,rle]} = ssl_trace:on([api,rle]),
+    [Server, Client] = ssl_connect(Config),
+    ssl_test_lib:close(Server),
+    ssl_test_lib:close(Client),
+    ActualTraceCnt = count_line("ssl_trace.txt"),
+    ExpectedTraceCnt = 10,
+    ssl_trace:stop(),
+    case ExpectedTraceCnt == ActualTraceCnt of
+        true ->
+            ok;
+        _ ->
+            ?FAIL("Expected ~w traces, but found ~w",
+                  [ExpectedTraceCnt, ActualTraceCnt])
+    end.
+
+%%%----------------------------------------------------------------
+ssl_trace_start() ->
+    ssl_trace_start(make_ref(), []).
+
+ssl_trace_start(Ref, TraceOpts) ->
+    TestProcess = self(),
+    [_|_] = ssl_trace:start(fun(Format,Args) ->
+                                    ct:log(Format, Args),
+                                    TestProcess ! {Ref, Args}
+                            end,
+                            TraceOpts),
+    Ref.
+
+receive_map(Ref) ->
+    Empty = #{call => [], return_from => [], exception_from => [],
+              processed => []},
+    receive_map(Ref, Empty).
+
+receive_map(Ref,
+               Map = #{call := Call, return_from := Return,
+                       exception_from := Exception, processed := Processed}) ->
+    receive
+        {Ref, Msg = [_, {call, {_, _, _}}, _]} ->
+            receive_map(Ref, Map#{call => [Msg|Call]});
+        {Ref, Msg = [_, {return_from, {_, _, _}, _}, _]} ->
+            receive_map(Ref, Map#{return_from => [Msg|Return]});
+        {Ref, Msg = [_, {exception_from, {_, _, _}, _}, _]} ->
+            receive_map(Ref, Map#{exception_from => [Msg|Exception]});
+        {Ref, Msg = [_Timestamp, _Pid, _ExpectString]} ->
+            %% processed means a trace was processed by Module:handle_trace
+            %% function and is not received as a trace tuple
+            receive_map(Ref, Map#{processed => [Msg|Processed]})
+    after 5000 ->
+            Map
+    end.
+
+check_trace_map(Ref, ExpectedTraces) ->
+    Received = receive_map(Ref),
+    L = [check_key(Type, ExpectedTraces, maps:get(Type, Received)) ||
+                  Type <- maps:keys(Received)],
+    maps:from_list(L).
+
+check_trace_map(Ref, ExpectedTraces, ExpectedRemainders) ->
+    ActualRemainders = check_trace_map(Ref, ExpectedTraces),
+    case ExpectedRemainders == ActualRemainders of
+        true ->
+            ok;
+        _ ->
+            ?FAIL("Expected trace remainders = ~w ~n"
+                 "Actual trace remainders = ~w",
+                 [ExpectedRemainders, ActualRemainders])
+    end.
+
+check_key(Type, ExpectedTraces, ReceivedPerType) ->
+    ReceivedPerTypeCnt = length(ReceivedPerType),
+    ?LOG("Received Type = ~w Messages# = ~w", [Type, ReceivedPerTypeCnt]),
+    case ReceivedPerTypeCnt > 0 of
+        true ->
+            ExpectedPerType = maps:get(Type, ExpectedTraces, []),
+            ExpectedPerTypeCnt = length(ExpectedPerType),
+            check_trace(Type, ExpectedPerType, ReceivedPerType),
+            {Type, ReceivedPerTypeCnt - ExpectedPerTypeCnt};
+        _ ->
+            {Type, no_trace_received}
+    end.
+
+-define(CHECK_TRACE(PATTERN, Expected),
+        fun({ExpectedString, Module, Function}) ->
+                P2 = fun(Received) ->
+                             PATTERN = Received,
+                             SearchResult =
+                                 string:str(lists:flatten(Txt), ExpectedString),
+                             case {Module == M, Function == F, SearchResult > 0} of
+                                 {true, true, true} ->
+                                     true;
+                                 _ -> false
+                             end
+                     end,
+                Result = lists:any(P2, ReceivedPerType),
+                case Result of
+                    false ->
+                        F = "Trace not found: {~s, ~w, ~w}",
+                        ?FAIL(F, [ExpectedString, Module, Function]);
+                    _ -> ok
+                end,
+                Result
+        end).
+
+-define(CHECK_PROCESSED_TRACE(PATTERN, Expected),
+        fun(ExpectedString) ->
+                P2 = fun(Received) ->
+                             PATTERN = Received,
+                             SearchResult =
+                                 string:str(lists:flatten(Txt), ExpectedString),
+                             SearchResult > 0
+                     end,
+                Result = lists:any(P2, ReceivedPerType),
+                case Result of
+                    false ->
+                        F = "Processed trace not found: ~s",
+                        ?FAIL(F, [ExpectedString]);
+                    _ -> ok
+                end,
+                Result
+        end).
+
+check_trace(call, ExpectedPerType, ReceivedPerType) ->
+    P1 = ?CHECK_TRACE([Txt, {call, {M, F, _Args}}, _], Expected),
+    true = lists:all(P1, ExpectedPerType);
+check_trace(return_from, ExpectedPerType, ReceivedPerType) ->
+    P1 = ?CHECK_TRACE([Txt, {return_from, {M, F, _Args}, _Return}, _], Expected),
+    true = lists:all(P1, ExpectedPerType);
+check_trace(exception_from, ExpectedPerType, ReceivedPerType) ->
+    P1 = ?CHECK_TRACE([Txt, {exception_from, {M, F, _Args}, _Return}, _], Expected),
+    true = lists:all(P1, ExpectedPerType);
+check_trace(processed, ExpectedPerType, ReceivedPerType) ->
+    P1 = ?CHECK_PROCESSED_TRACE([_Timestamp, _Pid, Txt], Expected),
+    true = lists:all(P1, ExpectedPerType);
+check_trace(Type, _ExpectedPerType, _ReceivedPerType) ->
+    ?FAIL("Type = ~w not checked", [Type]),
+    ok.
+
+count_line(Filename) ->
+    case file:open(Filename, [read]) of
+        {ok, IoDevice} ->
+            Count = count_line(IoDevice, 0),
+            file:close(IoDevice),
+            Count;
+        {error, Reason} ->
+            ?PAL("~s open error  reason:~s~n", [Filename, Reason]),
+            ng
+    end.
+
+count_line(IoDevice, Count) ->
+    case file:read_line(IoDevice) of
+        {ok, _} -> count_line(IoDevice, Count+1);
+        eof     -> Count
+    end.
+
+ssl_connect(Config) when is_list(Config) ->
+    ?LOG("Establishing connection for producing traces", []),
+    ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
+    ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config),
+    {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+    Server =
+	ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+				   {from, self()},
+				   {mfa, {ssl_test_lib, send_recv_result, []}},
+				   {options,  [{keepalive, true},{active, false}
+					       | ServerOpts]}]),
+    Port = ssl_test_lib:inet_port(Server),
+    Client =
+	ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+				   {host, Hostname},
+				   {from, self()},
+				   {mfa, {ssl_test_lib, send_recv_result, []}},
+				   {options, [{keepalive, true},{active, false}
+					      | ClientOpts]}]),
+    ?LOG("Testcase ~p, Client ~p  Server ~p ~n", [self(), Client, Server]),
+    [Server, Client].
-- 
2.35.3

Places

File 3841-ssl-add-ssl_trace-module.patch of Package erlang (Revision 5fabdb99534eebfde997df7f0642f69a)

Places