From 4e3aebd699f2b4fa9807938d563721212f7de88c Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Wed, 11 Sep 2024 12:01:14 +0200 Subject: [PATCH 1/9] [diameter|test] Add diameter event logger for parallel tc --- .../test/diameter_transport_SUITE.erl | 32 ++++++- lib/diameter/test/diameter_util.erl | 87 ++++++++++++++++++- lib/diameter/test/diameter_util.hrl | 3 + 3 files changed, 117 insertions(+), 5 deletions(-) diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index 1d9561c8929b..f1ebc3bfe582 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -204,6 +204,8 @@ reconnect({listen, Ref}) -> ?TL("reconnect(listen) -> entry with" "~n Ref: ~p", [Ref]), SvcName = make_ref(), + ?TL("reconnect(listen) -> start event logger"), + Logger = ?DEL_START("reconnect(listen)", SvcName), ?TL("reconnect(listen) -> start service (~p)", [SvcName]), ok = start_service(SvcName), ?TL("reconnect(listen) -> connect"), @@ -225,6 +227,9 @@ reconnect({listen, Ref}) -> ?TL("reconnect(listen) -> abort: wait for partner again"), Res = abort(SvcName, LRef, Ref), + ?TL("reconnect(listen) -> stop event logger"), + ?DEL_STOP(Logger), + ?TL("reconnect(listen) -> done when" "~n Res: ~p", [Res]), ok; @@ -234,15 +239,30 @@ reconnect({connect, Ref}) -> "~n Ref: ~p", [Ref]), SvcName = make_ref(), - ?TL("reconnect(connect) -> subscribe"), + ?TL("reconnect(connect) -> start event logger"), + Logger = ?DEL_START("reconnect(connect)", SvcName), + ?TL("reconnect(connect) -> subscribe to service ~p", [SvcName]), true = diameter:subscribe(SvcName), - ?TL("reconnect(connect) -> start service (~p)", [SvcName]), + ?TL("reconnect(connect) -> start service ~p", [SvcName]), ok = start_service(SvcName), - ?TL("reconnect(connect) -> wait"), + ?TL("reconnect(connect) -> wait when" + "~n Svc transports: ~p" + "~n Svc connections: ~p", + [diameter:service_info(SvcName, transport), + diameter:service_info(SvcName, connections)]), [{{_, _, LRef}, Pid}] = diameter_reg:wait({?MODULE, Ref, '_'}), - ?TL("reconnect(connect) -> connect"), + ?TL("reconnect(connect) -> connect when" + "~n Svc transports: ~p" + "~n Svc connections: ~p", + [diameter:service_info(SvcName, transport), + diameter:service_info(SvcName, connections)]), CRef = ?CONNECT(SvcName, tcp, LRef, [{connect_timer, 2000}, {watchdog_timer, 6000}]), + ?TL("reconnect(connect) -> connected when" + "~n Svc transports: ~p" + "~n Svc connections: ~p", + [diameter:service_info(SvcName, transport), + diameter:service_info(SvcName, connections)]), %% Tell partner to kill transport after seeing that there are no %% reconnection attempts. @@ -266,6 +286,9 @@ reconnect({connect, Ref}) -> MRef = erlang:monitor(process, Pid), Res = ?RECV({'DOWN', MRef, process, _, _}), + ?TL("reconnect(connect) -> stop event logger"), + ?DEL_STOP(Logger), + ?TL("reconnect(connect) -> done when" "~n Res: ~p", [Res]), ok; @@ -282,6 +305,7 @@ reconnect(Prot) -> "~n Res: ~p", [Res]), ok. + start_service(SvcName) -> OH = diameter_util:unique_string(), Opts = [{application, [{dictionary, diameter_gen_base_rfc6733}, diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 350c0abfe07a..42efef33c625 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -55,11 +55,13 @@ listen/2, listen/3, connect/3, connect/4, disconnect/4, - info/0 + info/0, + diameter_event_logger_start/2, diameter_event_logger_stop/1 ]). -export([analyze_and_print_host_info/0]). +-include("diameter.hrl"). -include("diameter_util.hrl"). @@ -538,11 +540,13 @@ connect(Client, ProtOpts, LRef, Opts) -> ?UL("no name: " "~n Services: ~p" "~n Service: ~p" + "~n Events: ~p" "~n 'all' Service Info: ~p" "~n 'info' Service Info: ~p" "~n 'stats' Service Info: ~p", [diameter:services(), Client, + diameter_events(Client), diameter:service_info(Client, all), diameter:service_info(Client, info), diameter:service_info(Client, statistics)]), @@ -574,6 +578,18 @@ connect(Client, ProtOpts, LRef, Opts) -> ?UL("~w -> done", [?FUNCTION_NAME]), Ref. +diameter_events(Svc) -> + diameter_events(Svc, []). + +diameter_events(Svc, Acc) -> + receive + #diameter_event{service = Svc} = Event -> + diameter_events(Svc, [Event | Acc]) + after 100 -> + lists:reverse(Acc) + end. + + head([T|_]) -> T; head(T) -> @@ -3030,6 +3046,75 @@ pinfo(P, Key) when is_pid(P) -> end. +%% --------------------------------------------------------------------------- + +diameter_event_logger_start(Name, SvcName) -> + Self = self(), + Logger = {Pid, _MRef} = + spawn_monitor(fun() -> + diameter_event_logger_init(Name, SvcName, Self) + end), + receive + {?MODULE, del, Pid, started} -> + Logger + end. + +diameter_event_logger_stop({Pid, MRef} = _Logger) -> + Pid ! {?MODULE, del, self(), stop}, + receive + {'DOWN', MRef, process, Pid, _} -> + ok + end. + +diameter_event_logger_init(Name, SvcName, Parent) -> + MRef = erlang:monitor(process, Parent), + diameter:subscribe(SvcName), + Parent ! {?MODULE, del, self(), started}, + diameter_event_logger_loop(Name, SvcName, Parent, MRef). + +diameter_event_logger_loop(Name, SvcName, Parent, MRef) -> + receive + {'DOWN', MRef, process, Parent, Reason} -> + diameter_event_msg(Name, SvcName, + "(diameter) event logger " + "received DOWN regarding parent: " + "~n Reason: ~p", + [Reason]), + diameter:unsubscribe(SvcName), + exit({parent_died, Reason}); + + {?MODULE, del, Parent, stop} -> + diameter_event_msg(Name, SvcName, + "(diameter) event logger " + "received 'stop' from parent", []), + diameter:unsubscribe(SvcName), + erlang:demonitor(MRef, [flush]), + exit(normal); + + #diameter_event{service = SvcName, info = Info} -> + diameter_event_msg(Name, SvcName, + "(diameter) event logger " + "received event: " + "~n Info: ~p", [Info]), + diameter_event_logger_loop(Name, SvcName, Parent, MRef) + end. + +diameter_event_msg(Name, SvcName, F, A) -> + io:format("==== DIAMETER EVENT ==== ~s ====~n" + "[~s, ~p] " ++ F ++ "~n", + [formated_timestamp(), Name, SvcName | A]). + +formated_timestamp() -> + format_timestamp(os:timestamp()). + +format_timestamp({_N1, _N2, N3} = TS) -> + {_Date, Time} = calendar:now_to_local_time(TS), + {Hour, Min, Sec} = Time, + FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.3.0w", + [Hour, Min, Sec, N3 div 1000]), + lists:flatten(FormatTS). + + %% --------------------------------------------------------------------------- f(F, A) -> diff --git a/lib/diameter/test/diameter_util.hrl b/lib/diameter/test/diameter_util.hrl index 560acf5ea9d9..c81be6fabae7 100644 --- a/lib/diameter/test/diameter_util.hrl +++ b/lib/diameter/test/diameter_util.hrl @@ -25,6 +25,9 @@ -define(LOG(F, A), ?LOG(atom_to_list(?MODULE), F, A)). -define(LOG(MS, F, A), ?DUTIL:log(MS, ?LINE, F, A)). + +-define(DEL_START(N, S), ?DUTIL:diameter_event_logger_start(N, S)). +-define(DEL_STOP(L), ?DUTIL:diameter_event_logger_stop(L)). -define(HAVE_SCTP(), ?DUTIL:have_sctp()). -define(MKTEMP(S), ?DUTIL:mktemp(S)). From 1849d3365e7a948f3cf057c45e5b3db7b9f0beeb Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 12 Sep 2024 16:39:50 +0200 Subject: [PATCH 2/9] [diameter|test] More and better info --- .../test/diameter_transport_SUITE.erl | 40 +++++++++- lib/diameter/test/diameter_util.erl | 78 +++++++++++++++++-- lib/diameter/test/diameter_util.hrl | 2 + 3 files changed, 113 insertions(+), 7 deletions(-) diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index f1ebc3bfe582..4d1fbe7f6c1c 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -530,9 +530,45 @@ gen_accept(tcp, LSock) -> gen_send(sctp, Sock, Bin) -> {OS, _IS, Id} = getr(assoc), - gen_sctp:send(Sock, Id, erlang:unique_integer([positive]) rem OS, Bin); + case gen_sctp:send(Sock, Id, erlang:unique_integer([positive]) rem OS, Bin) of + ok -> + ok; + {error, Reason} = ERROR -> + Info = try inet:info(Sock) of + I -> + I + catch + C:E:S -> + [{class, C}, + {error, E}, + {stack, S}] + end, + ?TL("Failed (sctp) sending message: " + "~n Reason: ~p" + "~n Socket: ~p" + "~n (Socket) Info: ~p", [Reason, Sock, Info]), + ERROR + end; gen_send(tcp, Sock, Bin) -> - gen_tcp:send(Sock, Bin). + case gen_tcp:send(Sock, Bin) of + ok -> + ok; + {error, Reason} = ERROR -> + Info = try inet:info(Sock) of + I -> + I + catch + C:E:S -> + [{class, C}, + {error, E}, + {stack, S}] + end, + ?TL("Failed (tcp) sending message: " + "~n Reason: ~p" + "~n Socket: ~p" + "~n (Socket) Info: ~p", [Reason, Sock, Info]), + ERROR + end. %% gen_recv/2 diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 42efef33c625..318ba9b10eb7 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -46,7 +46,8 @@ have_sctp/0, eprof/1, log/4, - proxy_call/4 + proxy_call/4, + f/2 ]). %% diameter-specific @@ -279,9 +280,9 @@ fold(Fun, Acc, #{} = Map) -> {'DOWN', MRef, process, Pid, Info} when is_map_key(MRef, Map) -> ?UL("fold -> process ~p terminated:" - "~n Info: ~p" + "~n Info: ~p" "~nwhen" - "~n Map Sz: ~p", [Pid, Info, maps:size(Map)]), + "~n Map: ~p", [Pid, Info, Map]), fold(Fun, Fun(Info, Acc), maps:remove(MRef, Map)) end. @@ -601,8 +602,18 @@ up(Client, Ref, Prot, PortNr) -> ?UL("~w -> received 'up' event regarding ~p for service ~p", [?FUNCTION_NAME, Ref, Client]), ok + after 10000 -> - {Client, Prot, PortNr, process_info(self(), messages)} + receive + {diameter_event, Client, {closed, Ref, Reason, _}} -> + ?UL("~w -> received unexpected 'closed' event " + "regarding ~p for service ~p: " + "~n Reason: ~p", + [?FUNCTION_NAME, Ref, Client, Reason]), + {error, {closed, Ref, Reason}} + after 0 -> + {Client, Prot, PortNr, process_info(self(), messages)} + end end. transport(SvcName, Ref) -> @@ -3095,7 +3106,8 @@ diameter_event_logger_loop(Name, SvcName, Parent, MRef) -> diameter_event_msg(Name, SvcName, "(diameter) event logger " "received event: " - "~n Info: ~p", [Info]), + "~n~s", + [format_diameter_event_info(" ", Info)]), diameter_event_logger_loop(Name, SvcName, Parent, MRef) end. @@ -3104,6 +3116,62 @@ diameter_event_msg(Name, SvcName, F, A) -> "[~s, ~p] " ++ F ++ "~n", [formated_timestamp(), Name, SvcName | A]). + +format_diameter_event_info(Indent, Event) + when (Event =:= start) orelse (Event =:= stop) -> + ?F("~s~w", [Indent, Event]); +format_diameter_event_info(Indent, + {up, Ref, Peer, _Config, _Pkt}) -> + ?F("~sup: " + "~n~s Ref: ~p" + "~n~s Peer: ~p", + [Indent, + Indent, Ref, + Indent, Peer]); +format_diameter_event_info(Indent, + {up, Ref, Peer, _Config}) -> + ?F("~sup: " + "~n~s Ref: ~p" + "~n~s Peer: ~p", + [Indent, + Indent, Ref, + Indent, Peer]); +format_diameter_event_info(Indent, + {down, Ref, Peer, _Config}) -> + ?F("~sdown: " + "~n~s Ref: ~p" + "~n~s Peer: ~p", + [Indent, + Indent, Ref, + Indent, Peer]); +format_diameter_event_info(Indent, + {reconnect, Ref, _Opts}) -> + ?F("~sreconnect: " + "~n~s Ref: ~p", + [Indent, + Indent, Ref]); +format_diameter_event_info(Indent, + {closed, Ref, Reason, _Config}) -> + ?F("~sclosed: " + "~n~s Ref: ~p" + "~n~s Reason: ~p", + [Indent, + Indent, Ref, + Indent, Reason]); +format_diameter_event_info(Indent, + {watchdog, Ref, PeerRef, {From, To}, _Config}) -> + ?F("~swatchdog: ~w -> ~w" + "~n~s Ref: ~p" + "~n~s PeerRef: ~p", + [Indent, From, To, + Indent, Ref, + Indent, PeerRef]); +format_diameter_event_info(Indent, Event) -> + ?F("~s~p", [Indent, Event]). + + + + formated_timestamp() -> format_timestamp(os:timestamp()). diff --git a/lib/diameter/test/diameter_util.hrl b/lib/diameter/test/diameter_util.hrl index c81be6fabae7..32e81e36d3f1 100644 --- a/lib/diameter/test/diameter_util.hrl +++ b/lib/diameter/test/diameter_util.hrl @@ -26,6 +26,8 @@ -define(LOG(F, A), ?LOG(atom_to_list(?MODULE), F, A)). -define(LOG(MS, F, A), ?DUTIL:log(MS, ?LINE, F, A)). +-define(F(F, A), ?DUTIL:f(F, A)). + -define(DEL_START(N, S), ?DUTIL:diameter_event_logger_start(N, S)). -define(DEL_STOP(L), ?DUTIL:diameter_event_logger_stop(L)). From f2d7afdb0d3e5367e50d69ca6aab635b1e818cc9 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Wed, 18 Sep 2024 07:24:34 +0200 Subject: [PATCH 3/9] [diameter|test] Add sctp platform skip --- lib/diameter/test/diameter_util.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 318ba9b10eb7..f2225f72281f 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -422,6 +422,8 @@ have_sctp() -> have_sctp("sparc-sun-solaris2.10") -> false; +have_sctp("x86_64-pc-solaris2.11") -> + false; have_sctp(_) -> case gen_sctp:open() of From 7b75d85c749a8f01988152c35df7a94cc636434a Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Wed, 18 Sep 2024 13:50:53 +0200 Subject: [PATCH 4/9] [diameter|test] More printouts --- lib/diameter/test/diameter_util.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index f2225f72281f..567dbbc01353 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -269,6 +269,8 @@ fold(Fun, Acc0, L) fold(_, Acc, Map) when 0 == map_size(Map) -> + ?UL("fold -> done when" + "~n Acc: ~p", [Acc]), Acc; fold(Fun, Acc, #{} = Map) -> From 936363c3e0cda4f294c0388a809775be776f3e83 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 19 Sep 2024 10:41:55 +0200 Subject: [PATCH 5/9] [diameter|test] Add debug to config suite --- lib/diameter/test/diameter_config_SUITE.erl | 98 +++++++++++++++++---- 1 file changed, 82 insertions(+), 16 deletions(-) diff --git a/lib/diameter/test/diameter_config_SUITE.erl b/lib/diameter/test/diameter_config_SUITE.erl index 8ab2490d16c3..3fadde1f4376 100644 --- a/lib/diameter/test/diameter_config_SUITE.erl +++ b/lib/diameter/test/diameter_config_SUITE.erl @@ -30,12 +30,18 @@ run/1]). %% common_test wrapping --export([suite/0, +-export([ + %% Framework functions + suite/0, all/0, + init_per_suite/1, + end_per_suite/1, + + %% The test cases start_service/1, add_transport/1]). --define(util, diameter_util). +-include("diameter_util.hrl"). %% Lists of {Key, GoodConfigList, BadConfigList} with which to %% configure. @@ -202,20 +208,44 @@ [x,x]], []}]). + +-define(CL(F), ?CL(F, [])). +-define(CL(F, A), ?LOG("DCONF", F, A)). + + %% =========================================================================== suite() -> [{timetrap, {seconds, 15}}]. all() -> - [start_service, - add_transport]. + [ + start_service, + add_transport + ]. + + +init_per_suite(Config) -> + ?DUTIL:init_per_suite(Config). + +end_per_suite(Config) -> + ?DUTIL:end_per_suite(Config). + start_service(_Config) -> - run([start_service]). + ?CL("~w -> entry", [?FUNCTION_NAME]), + Res = run([?FUNCTION_NAME]), + ?CL("~w -> done when" + "~n Res: ~p", [?FUNCTION_NAME, Res]), + Res. add_transport(_Config) -> - run([add_transport]). + ?CL("~w -> entry", [?FUNCTION_NAME]), + Res = run([?FUNCTION_NAME]), + ?CL("~w -> done when" + "~n Res: ~p", [?FUNCTION_NAME, Res]), + Res. + %% =========================================================================== @@ -225,44 +255,62 @@ run() -> run(List) when is_list(List) -> try - ?util:run([[[fun run/1, {F, 5000}] || F <- List]]) + ?RUN([[[fun run/1, {F, 5000}] || F <- List]]) after dbg:stop(), diameter:stop() end; run({F, Tmo}) -> + ?CL("~w -> entry - try start diameter", [?FUNCTION_NAME]), ok = diameter:start(), try - ?util:run([{[fun run/1, F], Tmo}]) + ?CL("~w -> try - start diameter", [?FUNCTION_NAME]), + ?RUN([{[fun run/1, F], Tmo}]) after + ?CL("~w -> after - try stop diameter", [?FUNCTION_NAME]), ok = diameter:stop() end; -run(start_service) -> - ?util:run([[fun start/1, T] +run(start_service = Case) -> + ?CL("~w(~w) -> entry", [?FUNCTION_NAME, Case]), + ?RUN([[fun start/1, T] || T <- [lists:keyfind(capabilities, 1, ?TRANSPORT_CONFIG) | ?SERVICE_CONFIG]]); -run(add_transport) -> - ?util:run([[fun add/1, T] || T <- ?TRANSPORT_CONFIG]). +run(add_transport = Case) -> + ?CL("~w(~w) -> entry", [?FUNCTION_NAME, Case]), + ?RUN([[fun add/1, T] || T <- ?TRANSPORT_CONFIG]). start(T) -> + ?CL("~w -> entry with" + "~n T: ~p", [?FUNCTION_NAME, T]), do(fun start/3, T). add(T) -> + ?CL("~w -> entry with" + "~n T: ~p", [?FUNCTION_NAME, T]), do(fun add/3, T). + %% =========================================================================== %% do/2 do(F, {Key, Good, Bad}) -> + ?CL("~w -> entry with" + "~n Key: ~p" + "~n Good: ~p" + "~n Bad: ~p", [?FUNCTION_NAME, Key, Good, Bad]), F(Key, Good, Bad). %% add/3 add(Key, Good, Bad) -> + ?CL("~w -> entry with" + "~n Key: ~p" + "~n Good: ~p" + "~n Bad: ~p", [?FUNCTION_NAME, Key, Good, Bad]), {[],[]} = {[{Vs,T} || Vs <- Good, T <- [add(Key, Vs)], [T] /= [T || {ok,_} <- [T]]], @@ -271,12 +319,19 @@ add(Key, Good, Bad) -> [T] /= [T || {error,_} <- [T]]]}. add(Key, Vs) -> + ?CL("~w -> entry with" + "~n Key: ~p" + "~n Vs: ~p", [?FUNCTION_NAME, Key, Vs]), T = list_to_tuple([Key | Vs]), diameter:add_transport(make_ref(), {connect, [T]}). %% start/3 start(Key, Good, Bad) -> + ?CL("~w -> entry with" + "~n Key: ~p" + "~n Good: ~p" + "~n Bad: ~p", [?FUNCTION_NAME, Key, Good, Bad]), {[],[]} = {[{Vs,T} || Vs <- Good, T <- [start(Key, Vs)], T /= ok], @@ -285,6 +340,9 @@ start(Key, Good, Bad) -> [T] /= [T || {error,_} <- [T]]]}. start(capabilities = K, [Vs]) -> + ?CL("~w -> entry with" + "~n K: ~p" + "~n Vs: ~p", [?FUNCTION_NAME, K, Vs]), if is_list(Vs) -> start(make_ref(), Vs ++ apps(K)); true -> @@ -293,18 +351,26 @@ start(capabilities = K, [Vs]) -> start(Key, Vs) when is_atom(Key) -> + ?CL("~w -> entry with" + "~n Key: ~p" + "~n Vs: ~p", [?FUNCTION_NAME, Key, Vs]), start(make_ref(), [list_to_tuple([Key | Vs]) | apps(Key)]); start(SvcName, Opts) -> try + ?CL("~w -> [try] - start service: " + "~n SvcName: ~p" + "~n Opts: ~p", [?FUNCTION_NAME, SvcName, Opts]), Res1 = diameter:start_service(SvcName, Opts), - %% io:format("[started] Is service ~p: ~p~n", - %% [SvcName, diameter:is_service(SvcName)]), + ?CL("~w -> [try] - start service result: " + "~n Res: ~p", [?FUNCTION_NAME, Res1]), Res1 after + ?CL("~w -> [after] - try stop service: " + "~n SvcName: ~p", [?FUNCTION_NAME, SvcName]), Res2 = diameter:stop_service(SvcName), - %% io:format("[stopped] Is service ~p: ~p~n", - %% [SvcName, diameter:is_service(SvcName)]), + ?CL("~w -> [after] - stop service result: " + "~n Res: ~p", [?FUNCTION_NAME, Res2]), Res2 end. From b5dc1c8d2b502e3ba12a5558ed1dcfcfda0d4852 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 19 Sep 2024 10:53:00 +0200 Subject: [PATCH 6/9] [diameter|test] Fixed timout calculation --- lib/diameter/test/diameter_util.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 567dbbc01353..7c5e06a8671f 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -3019,6 +3019,8 @@ pcall_loop(Pid, MRef, Timeout, PTimeout, TRef, Default) -> pinfo(Pid, reductions)]), Timeout2 = if + (Timeout =:= infinity) -> + Timeout; (Timeout < PTimeout) -> 0; true -> From 345c930a06500f06062a8d3601a24253687a0d2c Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Mon, 21 Oct 2024 10:11:32 +0200 Subject: [PATCH 7/9] [diameter|test] Tweaked dpr test case Assuming the connections info is async... --- lib/diameter/test/diameter_dpr_SUITE.erl | 49 +++++++++++++++++++----- 1 file changed, 39 insertions(+), 10 deletions(-) diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl index bf1e4904872e..2664eb270129 100644 --- a/lib/diameter/test/diameter_dpr_SUITE.erl +++ b/lib/diameter/test/diameter_dpr_SUITE.erl @@ -220,25 +220,27 @@ send_dpr(Config) -> "~n Config: ~p" "~n => try listen", [?FUNCTION_NAME, Config]), LRef = ?LISTEN(?SERVER, tcp), - ?DL("~w -> try listen", [?FUNCTION_NAME]), + ?DL("~w -> try connect", [?FUNCTION_NAME]), Ref = ?CONNECT(?CLIENT, tcp, LRef, [{dpa_timeout, 10000}]), ?DL("~w -> get sender", [?FUNCTION_NAME]), Svc = sender(group(Config)), ?DL("~w -> get connections for ~p", [?FUNCTION_NAME, Svc]), - Info = case diameter:service_info(Svc, connections) of - [I] -> - I; - [] -> - ?DL("send_dpr -> no connections found: " + Info = case sdpr_await_connections(Svc) of + no_connections -> + ?DL("~w -> no connections found: " "~n Svc: ~p" "~n Svc info: ~p" "~n Services: ~p", - [Svc, + [?FUNCTION_NAME, + Svc, diameter:service_info(Svc, all), diameter:services()]), - ct:fail({no_connections, Svc}) + ct:fail({no_connections, Svc}); + I -> + I end, {_, {TPid, _}} = lists:keyfind(peer, 1, Info), + ?DL("~w -> make a call (expect result 2001)", [?FUNCTION_NAME]), #diameter_base_DPA{'Result-Code' = 2001} = diameter:call(Svc, common, @@ -246,12 +248,39 @@ send_dpr(Config) -> {'Origin-Realm', "erlang.org"}, {'Disconnect-Cause', 0}], [{peer, TPid}]), + ?DL("~w -> await down event", [?FUNCTION_NAME]), ok = receive %% ensure the transport dies on DPA #diameter_event{service = ?CLIENT, info = {down, Ref, _, _}} -> + ?DL("~w -> received down event", [?FUNCTION_NAME]), ok after 5000 -> - erlang:process_info(self(), messages) - end. + MSGs = erlang:process_info(self(), messages), + ?DL("~w -> (down) event timeout: " + "~n ~p", [?FUNCTION_NAME, MSGs]), + MSGs + end, + ?DL("~w -> done", [?FUNCTION_NAME]), + ok. + + +-define(SDPR_AWAIT_CONN_N, 10). + +sdpr_await_connections(Svc) -> + sdpr_await_connections(Svc, ?SDPR_AWAIT_CONN_N). + +sdpr_await_connections(_Svc, 0) -> + no_connections; +sdpr_await_connections(Svc, N) -> + case diameter:service_info(Svc, connections) of + [I] when (N =:= ?SDPR_AWAIT_CONN_N) -> + I; + [I] when (N =/= ?SDPR_AWAIT_CONN_N) -> + ?DL("sdpr_await_connections -> connections found at ~w", [N]), + I; + [] -> + timer:sleep(500), + sdpr_await_connections(Svc, N-1) + end. %% sender/1 From 3c0d25214dc9d69c06a09da142e2e6d840becdaf Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Mon, 21 Oct 2024 18:54:01 +0200 Subject: [PATCH 8/9] [diameter|test] More tweaking Attempt figure out more info about spawned processes... --- lib/diameter/test/diameter_util.erl | 48 ++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 8 deletions(-) diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 7c5e06a8671f..64456c896403 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -203,14 +203,18 @@ await_down(ParentMRef, WorkerPid, N) -> "~n Initial Call: ~p" "~n Current Function: ~p" "~n Message Queue Length: ~p" + "~n (Process) Dictionary: ~p" "~n Reductions: ~p" - "~n Status: ~p", + "~n Status: ~p" + "~n Monitors: ~p", [WorkerPid, N, pi(WorkerPid, initial_call), pi(WorkerPid, current_function), pi(WorkerPid, message_queue_len), + pi(WorkerPid, dictionary), pi(WorkerPid, reductions), - pi(WorkerPid, status)]), + pi(WorkerPid, status), + pi(WorkerPid, monitors)]), timer:send_after(1000, self(), check_worker_status), await_down(ParentMRef, WorkerPid, N+1); @@ -240,17 +244,41 @@ await_down(ParentMRef, WorkerPid, N) -> end. +mq() -> + mq(self()). + +mq(Pid) when is_pid(Pid) -> + pi(Pid, messages). + pi(Pid, Key) -> try begin {Key, Value} = process_info(Pid, Key), - Value + process_pi_value(Key, Value) end catch _:_:_ -> undefined end. - + + +process_pi_value(monitors, Value) -> + process_monitors(Value); +process_pi_value(_, Value) -> + Value. + +process_monitors(Mons) -> + [process_monitor(Mon) || Mon <- Mons]. + +process_monitor({process, Pid}) + when is_pid(Pid) andalso (node(Pid) =:= node()) -> + {Pid, process_info(Pid, [initial_call, current_function, message_queue_len, + dictionary, reductions, status])}; +process_monitor({process, Pid}) -> + {Pid, undefined}; +process_monitor({port, Port}) -> + {Port, undefined}. + %% --------------------------------------------------------------------------- %% fold/3 @@ -276,15 +304,17 @@ fold(_, Acc, Map) fold(Fun, Acc, #{} = Map) -> receive check_worker_status -> + ?UL("~w -> check worker status when: " + "~n MQ: ~p", [?FUNCTION_NAME, mq()]), fold_display_workers_status(Map), timer:send_after(1000, self(), check_worker_status), fold(Fun, Acc, Map); {'DOWN', MRef, process, Pid, Info} when is_map_key(MRef, Map) -> - ?UL("fold -> process ~p terminated:" + ?UL("~w -> process ~p terminated:" "~n Info: ~p" "~nwhen" - "~n Map: ~p", [Pid, Info, Map]), + "~n Map: ~p", [?FUNCTION_NAME, Pid, Info, Map]), fold(Fun, Fun(Info, Acc), maps:remove(MRef, Map)) end. @@ -305,13 +335,15 @@ fold_display_worker_status(W) -> "~n Current Function: ~p" "~n Message Queue Length: ~p" "~n Reductions: ~p" - "~n Status: ~p", + "~n Status: ~p" + "~n Monitors: ~p", [W, pi(W, initial_call), pi(W, current_function), pi(W, message_queue_len), pi(W, reductions), - pi(W, status)]), + pi(W, status), + pi(W, monitors)]), ok. %% spawn_eval/1 From e0ba268004bfce7a624b23181bffbc51ce2b48ba Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 31 Oct 2024 08:08:08 +0100 Subject: [PATCH 9/9] [diameter|test] Timeout tweaking --- lib/diameter/test/diameter_config_SUITE.erl | 26 +++++++++++++++++---- lib/diameter/test/diameter_util.erl | 2 +- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/lib/diameter/test/diameter_config_SUITE.erl b/lib/diameter/test/diameter_config_SUITE.erl index 3fadde1f4376..8c9bd92d4a15 100644 --- a/lib/diameter/test/diameter_config_SUITE.erl +++ b/lib/diameter/test/diameter_config_SUITE.erl @@ -232,30 +232,48 @@ end_per_suite(Config) -> ?DUTIL:end_per_suite(Config). -start_service(_Config) -> +start_service(Config) -> ?CL("~w -> entry", [?FUNCTION_NAME]), + put(dia_factor, dia_factor(Config)), Res = run([?FUNCTION_NAME]), ?CL("~w -> done when" "~n Res: ~p", [?FUNCTION_NAME, Res]), Res. -add_transport(_Config) -> +add_transport(Config) -> ?CL("~w -> entry", [?FUNCTION_NAME]), + put(dia_factor, dia_factor(Config)), Res = run([?FUNCTION_NAME]), ?CL("~w -> done when" "~n Res: ~p", [?FUNCTION_NAME, Res]), Res. +dia_factor(Config) -> + {value, {?FUNCTION_NAME, DiaFactor}} = + lists:keysearch(?FUNCTION_NAME, 1, Config), + DiaFactor. %% =========================================================================== +%% Factor: >= 1 +to(Base, Factor) when (Factor >= 0) -> + round(Base * (((Factor-1) + 10) / 10)). + run() -> run(all()). run(List) when is_list(List) -> + BaseTo = 5000, + To = case get(dia_factor) of + undefined -> + BaseTo; + DF when is_integer(DF) -> + to(BaseTo, DF) + end, + ?CL("~w -> timeout calculated to ~w", [?FUNCTION_NAME, To]), try - ?RUN([[[fun run/1, {F, 5000}] || F <- List]]) + ?RUN([[[fun run/1, {F, To}] || F <- List]]) after dbg:stop(), diameter:stop() @@ -265,7 +283,7 @@ run({F, Tmo}) -> ?CL("~w -> entry - try start diameter", [?FUNCTION_NAME]), ok = diameter:start(), try - ?CL("~w -> try - start diameter", [?FUNCTION_NAME]), + ?CL("~w -> try - run ~p", [?FUNCTION_NAME, F]), ?RUN([{[fun run/1, F], Tmo}]) after ?CL("~w -> after - try stop diameter", [?FUNCTION_NAME]), diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 64456c896403..f094d683d22d 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -481,7 +481,7 @@ eval({F, Tmo}) ?UL("eval(~p) -> entry", [Tmo]), %% Since this function is used for all kinds of functions, %% a timeout is not very informative, so include the "function". - {ok, _} = timer:exit_after(Tmo, {timeout, F}), + {ok, _} = timer:exit_after(Tmo, {timeout, F, Tmo}), eval(F); eval({M,[F|A]})