From e96bcda0dff8bcb938bd98306d5e4e33c9443e40 Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Fri, 19 Sep 2025 19:24:28 +0200 Subject: [PATCH 1/5] ssh: add logger events checks in ssh_basic_SUITE --- lib/ssh/test/ssh_basic_SUITE.erl | 50 +++++++---- lib/ssh/test/ssh_connection_SUITE.erl | 124 ++------------------------ lib/ssh/test/ssh_protocol_SUITE.erl | 25 +++--- lib/ssh/test/ssh_test_lib.erl | 124 ++++++++++++++++++++++++-- lib/ssh/test/ssh_to_openssh_SUITE.erl | 20 ++--- 5 files changed, 182 insertions(+), 161 deletions(-) diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 81b73323f901..ab7e66ca0b34 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -190,8 +190,10 @@ init_per_group(_, Config) -> end_per_group(_, Config) -> Config. %%-------------------------------------------------------------------- -init_per_testcase(TC, Config) when TC==shell_no_unicode ; - TC==shell_unicode_string -> +init_per_testcase(TestCase, Config0) + 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), @@ -208,31 +210,47 @@ init_per_testcase(TC, Config) when TC==shell_no_unicode ; 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(inet6_option, Config) -> +init_per_testcase(TestCase = inet6_option, Config0) -> + Config = ssh_test_lib:add_log_handler(TestCase, Config0), case ssh_test_lib:has_inet6_address() of true -> init_per_testcase('__default__', Config); false -> {skip,"No ipv6 interface address"} end; -init_per_testcase(_TestCase, Config) -> - Config. +init_per_testcase(TestCase, Config) -> + ssh_test_lib:add_log_handler(TestCase, Config). -end_per_testcase(TC, Config) when TC==shell_no_unicode ; - TC==shell_unicode_string -> +end_per_testcase(TestCase, Config) + when TestCase==shell_no_unicode; + TestCase==shell_unicode_string -> case proplists:get_value(sftpd, Config) of {Pid, _, _} -> catch ssh:stop_daemon(Pid); _ -> ok end, - end_per_testcase(Config); -end_per_testcase(_TestCase, Config) -> - end_per_testcase(Config). - -end_per_testcase(_Config) -> - ok. + process_events(TestCase, Config); +end_per_testcase(TestCase, Config) -> + process_events(TestCase, Config). + +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. + +verify_events(_TestCase, 0) -> + ok; +verify_events(multi_daemon_opt_fd, 6) -> ok; +verify_events(internal_error, 3) -> ok; +verify_events(_TestCase, EventNumber) when EventNumber > 0-> + {fail, lists:flatten( + io_lib:format("unexpected event cnt: ~s", + [integer_to_list(EventNumber)]))}. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -1051,7 +1069,7 @@ parallel_login(Config) when is_list(Config) -> ok = ssh_connection:send(ConnectionRef, ChannelId, <<"Data">>), ok = ssh_connection:send(ConnectionRef, ChannelId, << >>), ssh_info:print(fun(Fmt, Args) -> io:fwrite(user, Fmt, Args) end), - {Parents, Conns, Handshakers} = + {_Parents, _Conns, _Handshakers} = ssh_test_lib:find_handshake_parent(Port), ssh:stop_daemon(Pid). @@ -1539,7 +1557,7 @@ wait_for_erlang_first_line(Config) -> {fail,no_ssh_connection}; <<"Eshell ",_/binary>> = _ErlShellStart -> ct:log("Erlang shell start: ~p~n", [_ErlShellStart]), - Config; + Config; Other -> ct:log("Unexpected answer from ssh server: ~p",[Other]), {fail,unexpected_answer} diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index f4b224818019..21eab4c69ffc 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -235,129 +235,22 @@ end_per_group(_, Config) -> Config. %%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> +init_per_testcase(TestCase, Config) -> ssh:stop(), ssh:start(), - {ok, TestLogHandlerRef} = ssh_test_lib:add_log_handler(), ssh_test_lib:verify_sanity_check(Config), - [{log_handler_ref, TestLogHandlerRef} | 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} = analyze_events(Events, EventCnt), + {ok, InterestingEventCnt} = ssh_test_lib:analyze_events(Events, EventCnt), VerificationResult = verify_events(TestCase, InterestingEventCnt), - ssh_test_lib:rm_log_handler(), + ssh_test_lib:rm_log_handler(TestCase), ssh:stop(), VerificationResult. -analyze_events(_, 0) -> - {ok, 0}; -analyze_events(Events, EventNumber) when EventNumber > 0 -> - {ok, Cnt} = print_interesting_events(Events, 0), - case Cnt > 0 of - true -> - ct:comment("(logger stats) interesting: ~p boring: ~p", - [Cnt, EventNumber - Cnt]); - _ -> - ct:comment("(logger stats) boring: ~p", - [length(Events)]) - end, - AllEventsSummary = lists:flatten([process_event(E) || E <- Events]), - ct:log("~nTotal logger events: ~p~nAll events:~n~s", [EventNumber, AllEventsSummary]), - {ok, Cnt}. - -process_event(#{msg := {report, - #{label := Label, - report := [{supervisor, Supervisor}, - {Status, Properties}]}}, - level := Level}) -> - format_event1(Label, Supervisor, Status, Properties, Level); -process_event(#{msg := {report, - #{label := Label, - report := [{supervisor, Supervisor}, - {errorContext, _ErrorContext}, - {reason, {Status, _ReasonDetails}}, - {offender, Properties}]}}, - level := Level}) -> - format_event1(Label, Supervisor, Status, Properties, Level); -process_event(#{msg := {report, - #{label := Label, - report := [{supervisor, Supervisor}, - {errorContext, _ErrorContext}, - {reason, Status}, - {offender, Properties}]}}, - level := Level}) -> - format_event1(Label, Supervisor, Status, Properties, Level); -process_event(#{msg := {report, - #{label := Label, - report := [Properties, []]}}, - level := Level}) -> - {status, Status} = get_value(status, Properties), - {pid, Pid} = get_value(pid, Properties), - Id = get_value(registered_name, Properties), - {initial_call, {M, F, Args}} = get_value(initial_call, Properties), - 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, - name := Pid, - reason := {Reason, _Stack = [{M, F, Args, Location} | _]}}}, - level := Level}) -> - io_lib:format("[~44s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~30s~n", - [io_lib:format("~p", [E]) || - E <- [Pid, Level, Label, Reason, undefined, M, F, Args, Location]]); -process_event(#{msg := {report, - #{label := Label, - format := Format, - args := Args}}, - meta := #{pid := Pid}, - level := Level}) -> - io_lib:format("[~44s] ~6s ~30s ~150s~n", - [io_lib:format("~p", [E]) || - E <- [Pid, Level, Label]] ++ [io_lib:format(Format, Args)]); -process_event(E) -> - io_lib:format("~n||RAW event||~n~p~n", [E]). - -format_event1(Label, Supervisor, Status, Properties, Level) -> - {pid, Pid} = get_value(pid, Properties), - Id = get_value(id, Properties), - {M, F, Args} = get_mfa_value(Properties), - RestartType = get_value(restart_type, Properties), - Significant = get_value(significant, Properties), - io_lib:format("[~30s <- ~10s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~20s ~25s~n", - [io_lib:format("~p", [E]) || - E <- [Supervisor, Pid, Level, Label, Status, Id, M, F, Args, - Significant, RestartType]]). - -get_mfa_value(Properties) -> - case get_value(mfargs, Properties) of - {mfargs, MFA} -> - MFA; - false -> - {mfa, MFA} = get_value(mfa, Properties), - MFA - end. - -get_value(Key, List) -> - case lists:keyfind(Key, 1, List) of - R = false -> - ct:log("Key ~p not found in~n~p", [Key, List]), - R; - R -> R - end. - -print_interesting_events([], Cnt) -> - {ok, Cnt}; -print_interesting_events([#{level := Level} = Event | Tail], Cnt) - when Level /= info, Level /= notice, Level /= debug -> - ct:log("------------~nInteresting event found:~n~p~n==========~n", [Event]), - print_interesting_events(Tail, Cnt + 1); -print_interesting_events([_|Tail], Cnt) -> - print_interesting_events(Tail, Cnt). - verify_events(_TestCase, 0) -> ok; verify_events(no_sensitive_leak, 1) -> ok; verify_events(max_channels_option, 3) -> ok; @@ -1647,7 +1540,8 @@ kex_error(Config) -> {preferred_algorithms,[{kex,[Kex1]}]} ]), Ref = make_ref(), - ok = ssh_log_h:add_fun(kex_error, + HandlerId = kex_error2, %% avoid conflict with ssh_test_lib log handler + ok = ssh_log_h:add_fun(HandlerId, fun(#{msg:={report,#{format:=Fmt,args:=As,label:={error_logger,_}}}}, Pid) -> true = (erlang:process_info(Pid) =/= undefined), % remove handler if we are dead Pid ! {Ref, lists:flatten(io_lib:format(Fmt,As))}; @@ -1657,7 +1551,7 @@ kex_error(Config) -> end, self()), Cleanup = fun() -> - ok = logger:remove_handler(kex_error), + ok = logger:remove_handler(HandlerId), ok = logger:set_primary_config(level, Level) end, try @@ -1670,7 +1564,7 @@ kex_error(Config) -> ]) of _ -> - ok = logger:remove_handler(kex_error), + ok = logger:remove_handler(HandlerId), ct:fail("expected failure", []) catch error:{badmatch,{error,"Key exchange failed"}} -> @@ -1796,7 +1690,7 @@ no_sensitive_leak(Config) -> end, %% Install the test handler: - Hname = no_sensitive_leak, + Hname = no_sensitive_leak2, %% avoid conflict with ssh_test_lib log handler ok = ssh_log_h:add_fun(Hname, fun(#{msg := {report,#{report := Rep}}}, Pid) -> true = (erlang:process_info(Pid, status) =/= undefined), % remove handler if we are dead diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index a4d8a778af56..6d54c951cb65 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -1083,19 +1083,20 @@ ext_info_c(Config) -> %%%-------------------------------------------------------------------- %%% kex_strict_negotiated(Config0) -> - {ok, TestRef} = ssh_test_lib:add_log_handler(), - Config = start_std_daemon(Config0, []), + Config = + ssh_test_lib:add_log_handler(?FUNCTION_NAME, + start_std_daemon(Config0, [])), {Server, Host, Port} = proplists:get_value(server, Config), Level = ssh_test_lib:get_log_level(), ssh_test_lib:set_log_level(debug), {ok, ConnRef} = std_connect({Host, Port}, Config, []), {algorithms, _A} = ssh:connection_info(ConnRef, algorithms), ssh:stop_daemon(Server), - {ok, Events} = ssh_test_lib:get_log_events(TestRef), + {ok, Events} = ssh_test_lib:get_log_events(Config), true = ssh_test_lib:kex_strict_negotiated(client, Events), true = ssh_test_lib:kex_strict_negotiated(server, Events), ssh_test_lib:set_log_level(Level), - ssh_test_lib:rm_log_handler(), + ssh_test_lib:rm_log_handler(?FUNCTION_NAME), ok. %% Connect to an erlang server and inject unexpected SSH message @@ -1202,9 +1203,9 @@ kex_strict_violation(Config) -> ct:log("==== END ====="), ok. -kex_strict_violation_2(Config) -> +kex_strict_violation_2(Config0) -> ExpectedReason = "KEX strict violation", - {ok, TestRef} = ssh_test_lib:add_log_handler(), + Config = ssh_test_lib:add_log_handler(?FUNCTION_NAME, Config0), Level = ssh_test_lib:get_log_level(), ssh_test_lib:set_log_level(debug), %% Connect and negotiate keys @@ -1245,8 +1246,8 @@ kex_strict_violation_2(Config) -> ct:log("2nd flow disconnect already received") end, ct:sleep(100), - {ok, Events} = ssh_test_lib:get_log_events(TestRef), - ssh_test_lib:rm_log_handler(), + {ok, Events} = ssh_test_lib:get_log_events(Config), + ssh_test_lib:rm_log_handler(?FUNCTION_NAME), ct:log("Events = ~p", [Events]), true = ssh_test_lib:kex_strict_negotiated(client, Events), true = ssh_test_lib:kex_strict_negotiated(server, Events), @@ -1269,8 +1270,8 @@ kex_strict_msg_unknown(Config) -> {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}], kex_strict_helper(Config, TestMessages, ExpectedReason). -kex_strict_helper(Config, TestMessages, ExpectedReason) -> - {ok, TestRef} = ssh_test_lib:add_log_handler(), +kex_strict_helper(Config0, TestMessages, ExpectedReason) -> + Config = ssh_test_lib:add_log_handler(?FUNCTION_NAME, Config0), Level = ssh_test_lib:get_log_level(), ssh_test_lib:set_log_level(debug), %% Connect and negotiate keys @@ -1292,8 +1293,8 @@ kex_strict_helper(Config, TestMessages, ExpectedReason) -> TestMessages, InitialState), ct:sleep(100), - {ok, Events} = ssh_test_lib:get_log_events(TestRef), - ssh_test_lib:rm_log_handler(), + {ok, Events} = ssh_test_lib:get_log_events(Config), + ssh_test_lib:rm_log_handler(?FUNCTION_NAME), ct:log("Events = ~p", [Events]), true = ssh_test_lib:kex_strict_negotiated(client, Events), true = ssh_test_lib:kex_strict_negotiated(server, Events), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index b9bbc9e1f3a4..7cba0dc186f1 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -25,6 +25,7 @@ -module(ssh_test_lib). -export([ +analyze_events/2, connect/2, connect/3, daemon/1, @@ -134,8 +135,9 @@ find_handshake_parent/1 ]). %% logger callbacks and related helpers -export([log/2, - get_log_level/0, set_log_level/1, add_log_handler/0, - rm_log_handler/0, get_log_events/1]). + get_log_level/0, set_log_level/1, + add_log_handler/2, rm_log_handler/1, + get_log_events/1]). -include_lib("common_test/include/ct.hrl"). -include("ssh_transport.hrl"). @@ -1350,22 +1352,24 @@ get_log_level() -> set_log_level(Level) -> ok = logger:set_primary_config(level, Level). -add_log_handler() -> - logger:remove_handler(?MODULE), +add_log_handler(HandlerId, Config) -> + logger:remove_handler(HandlerId), TestRef = make_ref(), - ok = logger:add_handler(?MODULE, ?MODULE, + ok = logger:add_handler(HandlerId, ?MODULE, #{level => debug, filter_default => log, recipient => self(), test_ref => TestRef}), - {ok, TestRef}. + [{log_handler_ref, TestRef} | Config]. -rm_log_handler() -> - ok = logger:remove_handler(?MODULE). +rm_log_handler(HandlerId) -> + ok = logger:remove_handler(HandlerId). get_log_events(TestRef) -> {ok, get_log_events(TestRef, [])}. +get_log_events(Config, Acc) when is_list(Config) -> + get_log_events(proplists:get_value(log_handler_ref, Config), Acc); get_log_events(TestRef, Acc) -> receive {TestRef, Event} -> @@ -1375,6 +1379,110 @@ get_log_events(TestRef, Acc) -> Acc end. +analyze_events(Events, EventNumber) when EventNumber >= 0 -> + {ok, Cnt} = print_interesting_events(Events, 0), + case Cnt > 0 of + true -> + ct:comment("LGR interesting: ~p boring: ~p", + [Cnt, EventNumber - Cnt]); + _ -> + ct:comment("LGR boring: ~p", + [length(Events)]) + end, + AllEventsSummary = lists:flatten([process_event(E) || E <- Events]), + ct:log("~nTotal logger events: ~p~nAll events:~n~s", [EventNumber, AllEventsSummary]), + {ok, Cnt}. + +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {Status, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {errorContext, _ErrorContext}, + {reason, {Status, _ReasonDetails}}, + {offender, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {errorContext, _ErrorContext}, + {reason, Status}, + {offender, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [Properties, []]}}, + level := Level}) -> + {status, Status} = get_value(status, Properties), + {pid, Pid} = get_value(pid, Properties), + Id = get_value(registered_name, Properties), + {initial_call, {M, F, Args}} = get_value(initial_call, Properties), + 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, + name := Pid, + reason := {Reason, _Stack = [{M, F, Args, Location} | _]}}}, + level := Level}) -> + io_lib:format("[~44s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~30s~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label, Reason, undefined, M, F, Args, Location]]); +process_event(#{msg := {report, + #{label := Label, + format := Format, + args := Args}}, + meta := #{pid := Pid}, + level := Level}) -> + io_lib:format("[~44s] ~6s ~30s ~150s~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label]] ++ [io_lib:format(Format, Args)]); +process_event(E) -> + io_lib:format("~n||RAW event||~n~p~n", [E]). + +format_event1(Label, Supervisor, Status, Properties, Level) -> + {pid, Pid} = get_value(pid, Properties), + Id = get_value(id, Properties), + {M, F, Args} = get_mfa_value(Properties), + RestartType = get_value(restart_type, Properties), + Significant = get_value(significant, Properties), + io_lib:format("[~30s <- ~10s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~20s ~25s~n", + [io_lib:format("~p", [E]) || + E <- [Supervisor, Pid, Level, Label, Status, Id, M, F, Args, + Significant, RestartType]]). + +get_mfa_value(Properties) -> + case get_value(mfargs, Properties) of + {mfargs, MFA} -> + MFA; + false -> + {mfa, MFA} = get_value(mfa, Properties), + MFA + end. + +get_value(Key, List) -> + case lists:keyfind(Key, 1, List) of + R = false -> + ct:log("Key ~p not found in~n~p", [Key, List]), + R; + R -> R + end. + +print_interesting_events([], Cnt) -> + {ok, Cnt}; +print_interesting_events([#{level := Level} = Event | Tail], Cnt) + when Level /= info, Level /= notice, Level /= debug -> + ct:log("------------~nInteresting event found:~n~p~n==========~n", [Event]), + print_interesting_events(Tail, Cnt + 1); +print_interesting_events([_|Tail], Cnt) -> + print_interesting_events(Tail, Cnt). + %% logger callbacks log(LogEvent = #{level:=_Level,msg:=_Msg,meta:=_Meta}, #{test_ref := TestRef, recipient := Recipient}) -> diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 6793aa64be1b..56b5053452c3 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -157,17 +157,17 @@ end_per_testcase(_TestCase, _Config) -> erlang_shell_client_openssh_server(Config) when is_list(Config) -> eclient_oserver_helper2(eclient_oserver_helper1(), Config). -eclient_oserver_kex_strict(Config) when is_list(Config)-> - case proplists:get_value(kex_strict, Config) of +eclient_oserver_kex_strict(Config0) when is_list(Config0)-> + case proplists:get_value(kex_strict, Config0) of true -> - {ok, TestRef} = ssh_test_lib:add_log_handler(), + Config = ssh_test_lib:add_log_handler(?FUNCTION_NAME, Config0), Level = ssh_test_lib:get_log_level(), ssh_test_lib:set_log_level(debug), HelperParams = eclient_oserver_helper1(), - {ok, Events} = ssh_test_lib:get_log_events(TestRef), + {ok, Events} = ssh_test_lib:get_log_events(Config), true = ssh_test_lib:kex_strict_negotiated(client, Events), ssh_test_lib:set_log_level(Level), - ssh_test_lib:rm_log_handler(), + ssh_test_lib:rm_log_handler(?FUNCTION_NAME), eclient_oserver_helper2(HelperParams, Config); _ -> {skip, "KEX strict not support by local OpenSSH"} @@ -268,19 +268,19 @@ erlang_server_openssh_client_renegotiate(Config) -> eserver_oclient_renegotiate_helper2( eserver_oclient_renegotiate_helper1(Config)). -eserver_oclient_kex_strict(Config) -> - case proplists:get_value(kex_strict, Config) of +eserver_oclient_kex_strict(Config0) -> + case proplists:get_value(kex_strict, Config0) of true -> - {ok, TestRef} = ssh_test_lib:add_log_handler(), + Config = ssh_test_lib:add_log_handler(?FUNCTION_NAME, Config0), Level = ssh_test_lib:get_log_level(), ssh_test_lib:set_log_level(debug), HelperParams = eserver_oclient_renegotiate_helper1(Config), - {ok, Events} = ssh_test_lib:get_log_events(TestRef), + {ok, Events} = ssh_test_lib:get_log_events(Config), ct:log("Events = ~n~p", [Events]), true = ssh_test_lib:kex_strict_negotiated(server, Events), ssh_test_lib:set_log_level(Level), - ssh_test_lib:rm_log_handler(), + ssh_test_lib:rm_log_handler(?FUNCTION_NAME), eserver_oclient_renegotiate_helper2(HelperParams); _ -> {skip, "KEX strict not support by local OpenSSH"} From 7ba2661f9344052d66b6f7fe45a14bea990d78aa Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Mon, 22 Sep 2025 16:29:45 +0200 Subject: [PATCH 2/5] ssh: add CT_LOG, CT_PAL to ssh_test_lib.hrl --- lib/ssh/test/ssh_test_lib.hrl | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/lib/ssh/test/ssh_test_lib.hrl b/lib/ssh/test/ssh_test_lib.hrl index 89e5e1e1944c..1b6c02aab083 100644 --- a/lib/ssh/test/ssh_test_lib.hrl +++ b/lib/ssh/test/ssh_test_lib.hrl @@ -80,12 +80,26 @@ -define(wait_match(Pattern, FunctionCall), ?wait_match(Pattern, FunctionCall, ok)). -%%------------------------------------------------------------------------- -%% Write file into log -%%------------------------------------------------------------------------- -define(ct_log_show_file(File), (fun(File__) -> {ok,Contents__} = file:read_file(File__), ct:log("~p:~p Show file~n~s =~n~s~n", [?MODULE,?LINE,File__, Contents__]) end)(File)). + +-define(SSH_TEST_LIB_FORMAT, "(~s ~p:~p in ~p) "). +-define(SSH_TEST_LIB_ARGS, + [erlang:pid_to_list(self()), ?MODULE, ?LINE, ?FUNCTION_NAME]). +-define(CT_LOG(F), + (ct:log(?SSH_TEST_LIB_FORMAT ++ F, ?SSH_TEST_LIB_ARGS, [esc_chars]))). +-define(CT_LOG(F, Args), + (ct:log( + ?SSH_TEST_LIB_FORMAT ++ F, + ?SSH_TEST_LIB_ARGS ++ Args, + [esc_chars]))). +-define(CT_PAL(F), + (ct:pal(?SSH_TEST_LIB_FORMAT ++ F, ?SSH_TEST_LIB_ARGS))). +-define(CT_PAL(F, Args), + (ct:pal(?SSH_TEST_LIB_FORMAT ++ F, ?SSH_TEST_LIB_ARGS ++ Args))). +-define(CT_FAIL(F, Args), + (ct:fail(?SSH_TEST_LIB_FORMAT ++ F, ?SSH_TEST_LIB_ARGS ++ Args))). From 72857c2b0ebf4ccbee4f4a405e28670cb59d3cf5 Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Thu, 25 Sep 2025 17:34:45 +0200 Subject: [PATCH 3/5] ssh: enhance event processing in ssh_test_lib --- lib/ssh/test/ssh_test_lib.erl | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 7cba0dc186f1..4dfcc3fe879f 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -1443,6 +1443,21 @@ process_event(#{msg := {report, io_lib:format("[~44s] ~6s ~30s ~150s~n", [io_lib:format("~p", [E]) || E <- [Pid, Level, Label]] ++ [io_lib:format(Format, Args)]); +process_event(#{msg := {Format, Args}, + meta := #{pid := Pid}, + level := Level}) when is_list(Format), is_list(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 := {report, + #{label := Label, + reason := Reason, + process_label := ProcessLabel}}, + meta := #{pid := Pid}, + level := Level}) -> + io_lib:format("[~44s] ~6s ~30s ~30s~n~s~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label, ProcessLabel, Reason]]); process_event(E) -> io_lib:format("~n||RAW event||~n~p~n", [E]). From 32bfd50cca14591e7df3a011729d98fcf0f1e62c Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Thu, 2 Oct 2025 10:34:11 +0200 Subject: [PATCH 4/5] ssh: in test print Pty_bin --- lib/ssh/test/ssh_test_cli.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index f96b9967d2bf..72902325ea65 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -74,7 +74,8 @@ terminate(_Why, _S) -> nop. run_portprog(User, cli, TmpDir) -> - Pty_bin = os:find_executable("cat"), + Pty_bin = os:find_executable("cat"), + ct:pal("Pty_bin = ~p", [Pty_bin]), ssh_test_lib:open_port({spawn_executable, Pty_bin}, [stream, {cd, TmpDir}, From 9bae43ded78fe0418944a9708f080bc8a179039f Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Fri, 3 Oct 2025 16:35:53 +0200 Subject: [PATCH 5/5] ssh: fix cli testcase in Windows - add FIXME comment for logger events verification in parallel groups --- lib/ssh/test/ssh_basic_SUITE.erl | 4 ++++ lib/ssh/test/ssh_test_cli.erl | 6 +++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index ab7e66ca0b34..ad2a7784698f 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -234,6 +234,10 @@ end_per_testcase(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)), diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index 72902325ea65..b9f348068b9d 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -74,7 +74,11 @@ terminate(_Why, _S) -> nop. run_portprog(User, cli, TmpDir) -> - Pty_bin = os:find_executable("cat"), + Cmd = case os:type() of + {win32, _} -> "cmd.exe"; + _ -> "cat" + end, + Pty_bin = os:find_executable(Cmd), ct:pal("Pty_bin = ~p", [Pty_bin]), ssh_test_lib:open_port({spawn_executable, Pty_bin}, [stream,