File 1451-ssh-add-cth_events-and-event-verification-for-ssh_pr.patch of Package erlang
From 98fdca2e170585ff40a4224615d9d07354ec385d Mon Sep 17 00:00:00 2001
From: Jakub Witczak <kuba@erlang.org>
Date: Thu, 16 Oct 2025 18:00:30 +0200
Subject: [PATCH] ssh: add cth_events and event verification for
ssh_protocol_SUITE
- add ssh/test/cth_events - hook module for verifying logger
events
- verify logger events for ssh_protocol_SUITE
- use cth_events in other test suites
---
lib/ssh/test/Makefile | 1 +
lib/ssh/test/cth_events.erl | 97 +++++++++++++++++++++++++++
lib/ssh/test/ssh_basic_SUITE.erl | 33 +++------
lib/ssh/test/ssh_connection_SUITE.erl | 22 +++---
lib/ssh/test/ssh_protocol_SUITE.erl | 22 +++++-
lib/ssh/test/ssh_test_lib.erl | 14 ++++
6 files changed, 151 insertions(+), 38 deletions(-)
create mode 100644 lib/ssh/test/cth_events.erl
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 44b1a82c3c..a92c7d551f 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# ----------------------------------------------------
MODULES= \
+ cth_events \
ssh_cth \
ssh_algorithms_SUITE \
ssh_options_SUITE \
diff --git a/lib/ssh/test/cth_events.erl b/lib/ssh/test/cth_events.erl
new file mode 100644
index 0000000000..8f3891884e
--- /dev/null
+++ b/lib/ssh/test/cth_events.erl
@@ -0,0 +1,97 @@
+%%
+%% %CopyrightBegin%
+%%
+%% SPDX-License-Identifier: Apache-2.0
+%%
+%% Copyright Ericsson AB 2011-2025. 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(cth_events).
+-moduledoc false.
+
+%%% This module verifies logger events.
+
+%% CTH Callbacks
+-export([id/1, init/2,
+ %% pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4,
+ %% pre_init_per_group/4, post_init_per_group/5,
+ %% pre_end_per_group/4, post_end_per_group/5,
+ pre_init_per_testcase/4, %post_init_per_testcase/5,
+ %% pre_end_per_testcase/4,
+ post_end_per_testcase/5]).
+
+-behaviour(ct_hooks).
+
+id(_Opts) ->
+ ?MODULE.
+
+init(?MODULE, Opts) ->
+ GetValue =
+ fun(Property, PropList, Default) ->
+ case proplists:get_value(Property, PropList) of
+ undefined -> Default;
+ V -> V
+ end
+ end,
+
+ DefaultVerifyFun =
+ fun(_, 0) ->
+ ok;
+ (_, EventNumber) when EventNumber > 0 ->
+ {fail, lists:flatten(
+ io_lib:format("unexpected event cnt: ~s",
+ [integer_to_list(EventNumber)]))}
+ end,
+ VerifyFun = GetValue(verify_fun, Opts, DefaultVerifyFun),
+ SkipTc = GetValue(skip_tc, Opts, []),
+ ct_util:mark_process(), % ??
+ {ok, #{verify_fun => VerifyFun, skip_tc => SkipTc}}.
+
+%% FIXME in parallel executions (e.g. ssh_basic_SUITE:p_basic group) this setup does not
+%% work log handlers are uniq per testcase, but they all receive same
+%% logger events; so if one testcase fails due to logger events, rest
+%% of group might fail as well
+pre_init_per_testcase(_Suite, TestCase, Config0, State = #{skip_tc := SkipTc}) ->
+ case lists:member(TestCase, SkipTc) of
+ false ->
+ Config = ssh_test_lib:add_log_handler(TestCase, Config0),
+ {Config, State};
+ true ->
+ {Config0, State}
+ end.
+
+post_end_per_testcase(_Suite, TestCase, Config, Result,
+ State = #{skip_tc := SkipTc,
+ verify_fun := VerifyFun}) ->
+ case lists:member(TestCase, SkipTc) of
+ false ->
+ {ok, Events} = ssh_test_lib:get_log_events(
+ proplists:get_value(log_handler_ref, Config)),
+ EventCnt = length(Events),
+ {ok, InterestingEventCnt} = ssh_test_lib:analyze_events(Events, EventCnt),
+ VerificationResult = VerifyFun(TestCase, InterestingEventCnt),
+ ssh_test_lib:rm_log_handler(TestCase),
+ case VerificationResult of
+ ok ->
+ {Result, State};
+ _ ->
+ {VerificationResult, State}
+ end;
+ true ->
+ {Result, State}
+ end.
+
+
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 8027e5b43c..98d5868a7f 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -109,7 +109,9 @@
%%--------------------------------------------------------------------
suite() ->
- [{ct_hooks,[ts_install_cth]},
+ [{ct_hooks,[ts_install_cth,
+ {cth_events,
+ [{verify_fun, fun verify_events/2}]}]},
{timetrap,{seconds,90}}].
all() ->
@@ -190,10 +192,9 @@ init_per_group(_, Config) ->
end_per_group(_, Config) ->
Config.
%%--------------------------------------------------------------------
-init_per_testcase(TestCase, Config0)
+init_per_testcase(TestCase, Config)
when TestCase==shell_no_unicode;
TestCase==shell_unicode_string ->
- Config = ssh_test_lib:add_log_handler(TestCase, Config0),
PrivDir = proplists:get_value(priv_dir, Config),
UserDir = proplists:get_value(priv_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
@@ -210,8 +211,7 @@ init_per_testcase(TestCase, Config0)
ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p",
[file:native_name_encoding(),io:getopts()]),
wait_for_erlang_first_line([{io,IO}, {shell,Shell}, {sftpd, Sftpd} | Config]);
-init_per_testcase(TestCase = inet6_option, Config0) ->
- Config = ssh_test_lib:add_log_handler(TestCase, Config0),
+init_per_testcase(inet6_option, Config) ->
case ssh_test_lib:has_inet6_address() of
true ->
init_per_testcase('__default__', Config);
@@ -226,26 +226,13 @@ end_per_testcase(TestCase, Config)
TestCase==shell_unicode_string ->
case proplists:get_value(sftpd, Config) of
{Pid, _, _} ->
- catch ssh:stop_daemon(Pid);
+ catch ssh:stop_daemon(Pid),
+ ok;
_ ->
ok
- end,
- process_events(TestCase, Config);
-end_per_testcase(TestCase, Config) ->
- process_events(TestCase, Config).
-
-%% FIXME in parallel executions (p_basic group) this setup does not
-%% work log handlers are uniq per testcase, but they all receive same
-%% logger events; so if one testcase fails due to logger events, rest
-%% of group might fail as well
-process_events(TestCase, Config) ->
- {ok, Events} = ssh_test_lib:get_log_events(
- proplists:get_value(log_handler_ref, Config)),
- EventCnt = length(Events),
- {ok, InterestingEventCnt} = ssh_test_lib:analyze_events(Events, EventCnt),
- VerificationResult = verify_events(TestCase, InterestingEventCnt),
- ssh_test_lib:rm_log_handler(TestCase),
- VerificationResult.
+ end;
+end_per_testcase(_TestCase, _Config) ->
+ ok.
verify_events(_TestCase, 0) ->
ok;
diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl
index 21eab4c69f..da1fef6748 100644
--- a/lib/ssh/test/ssh_connection_SUITE.erl
+++ b/lib/ssh/test/ssh_connection_SUITE.erl
@@ -125,7 +125,10 @@
%% [{ct_hooks,[ts_install_cth]}].
suite() ->
- [{timetrap,{seconds,40}}].
+ [{ct_hooks,[ts_install_cth,
+ {cth_events,
+ [{verify_fun, fun verify_events/2}]}]},
+ {timetrap,{seconds,40}}].
all() ->
[
@@ -235,21 +238,14 @@ end_per_group(_, Config) ->
Config.
%%--------------------------------------------------------------------
-init_per_testcase(TestCase, Config) ->
+init_per_testcase(_TestCase, Config) ->
ssh:stop(),
ssh:start(),
ssh_test_lib:verify_sanity_check(Config),
- ssh_test_lib:add_log_handler(TestCase, Config).
-
-end_per_testcase(TestCase, Config) ->
- {ok, Events} = ssh_test_lib:get_log_events(
- proplists:get_value(log_handler_ref, Config)),
- EventCnt = length(Events),
- {ok, InterestingEventCnt} = ssh_test_lib:analyze_events(Events, EventCnt),
- VerificationResult = verify_events(TestCase, InterestingEventCnt),
- ssh_test_lib:rm_log_handler(TestCase),
- ssh:stop(),
- VerificationResult.
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ssh:stop().
verify_events(_TestCase, 0) -> ok;
verify_events(no_sensitive_leak, 1) -> ok;
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 1d905c2644..1eec7924a3 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -123,7 +123,25 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
suite() ->
- [{ct_hooks,[ts_install_cth]},
+ VerifyFun =
+ fun(_, 0) ->
+ ok;
+ (client_close_after_hello, 1) ->
+ ok;
+ (extra_ssh_msg_service_request, 1) ->
+ ok;
+ (_, EventNumber) ->
+ {fail, lists:flatten(
+ io_lib:format("unexpected event cnt: ~s",
+ [integer_to_list(EventNumber)]))}
+ end,
+ SkipTc = [kex_strict_negotiated,
+ kex_strict_violation,
+ kex_strict_violation_2],
+ [{ct_hooks,[ts_install_cth,
+ {cth_events,
+ [{verify_fun, VerifyFun},
+ {skip_tc, SkipTc}]}]},
{timetrap,{seconds,40}}].
all() ->
@@ -550,7 +568,7 @@ no_common_alg_client_disconnects(Config) ->
ct:log("ERROR!~nOp = ~p~nExecResult = ~p~nState =~n~s",
[Op,ExecResult,ssh_trpt_test_lib:format_msg(S)]),
{fail, ExecResult};
- X ->
+ {result, Pid, X} ->
ct:log("¤¤¤¤¤"),
ct:fail(X)
after
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index 4dfcc3fe87..9c8b01c1c0 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -1426,6 +1426,14 @@ process_event(#{msg := {report,
io_lib:format("[~44s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s)~n",
[io_lib:format("~p", [E]) ||
E <- [Pid, Level, Label, Status, Id, M, F, Args]]);
+process_event(#{msg := {report,
+ #{label := Label,
+ report := [MsgString]}},
+ meta := #{pid := Pid},
+ level := Level}) ->
+ io_lib:format("[~44s] ~6s ~20s ~s~n",
+ [io_lib:format("~p", [E]) ||
+ E <- [Pid, Level, Label]] ++ [MsgString]);
process_event(#{msg := {report,
#{label := Label,
name := Pid,
@@ -1449,6 +1457,12 @@ process_event(#{msg := {Format, Args},
io_lib:format("[~44s] ~6s~n~s~n",
[io_lib:format("~p", [E]) ||
E <- [Pid, Level]] ++ [io_lib:format(Format, Args)]);
+process_event(#{msg := {string, MsgString},
+ meta := #{pid := Pid},
+ level := Level}) when is_list(MsgString) ->
+ io_lib:format("[~44s] ~6s ~s~n",
+ [io_lib:format("~p", [E]) ||
+ E <- [Pid, Level]] ++ [MsgString]);
process_event(#{msg := {report,
#{label := Label,
reason := Reason,
--
2.51.0
