aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2012-10-07 23:34:51 +0200
committerAnders Svensson <[email protected]>2012-11-05 11:53:46 +0100
commitbcc2e7751b014d4fc9d45c4a138278cbd00cc222 (patch)
treedf88fbf4eb6c81dede1689f6e3c837a9e0f9a2e5
parentf0219f3b56776ded12613c8a5a5603b4542b9ba2 (diff)
downloadotp-bcc2e7751b014d4fc9d45c4a138278cbd00cc222.tar.gz
otp-bcc2e7751b014d4fc9d45c4a138278cbd00cc222.tar.bz2
otp-bcc2e7751b014d4fc9d45c4a138278cbd00cc222.zip
Redo watchdog test suite
It was broken by sequence masks and can be simplified using (the new-ish) watchdog events.
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl711
1 files changed, 354 insertions, 357 deletions
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
index ff40326947..7ce09e93ca 100644
--- a/lib/diameter/test/diameter_watchdog_SUITE.erl
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,11 +30,21 @@
end_per_suite/1]).
%% testcases
--export([reopen/1, reopen/4]).
+-export([reopen/1, reopen/4, reopen/7]).
--export([start/3, %% diameter_transport callback
- id/1, %% jitter callback
- run/1]).
+-export([id/1, %% jitter callback
+ run1/1]).
+
+%% diameter_app callbacks
+-export([peer_up/3,
+ peer_down/3]).
+
+%% gen_tcp-ish interface
+-export([listen/2,
+ accept/1,
+ connect/3,
+ send/2,
+ setopts/2]).
-include("diameter.hrl").
-include("diameter_ct.hrl").
@@ -43,33 +53,21 @@
-define(util, diameter_util).
--define(BASE, diameter_gen_base_rfc3588).
--define(APPL_ID, diameter_gen_base_rfc3588:id()).
--define(SUCCESS, 2001). %% DIAMETER_SUCCESS
-
-%% Addresses for the local and remote diameter nodes. The values don't
-%% matter since we're faking transport.
--define(LOCALHOST, {127,0,0,1}).
--define(REMOTEHOST, {10,0,0,1}).
-
--define(CAPS, #diameter_caps{origin_host = "node.innan.com",
- origin_realm = "innan.com",
- host_ip_address = [?LOCALHOST],
- vendor_id = 1022,
- product_name = "remote",
- auth_application_id = [?APPL_ID]}).
-
--define(APPL, #diameter_app{alias = ?MODULE,
- dictionary = ?BASE,
- module = [?MODULE],
- init_state = now(),
- id = ?APPL_ID,
- mutable = false}).
-
-%% Service record maintained by our faked service process.
--define(SERVICE, #diameter_service{pid = self(),
- capabilities = ?CAPS,
- applications = [?APPL]}).
+-define(BASE, ?DIAMETER_DICT_COMMON).
+-define(REALM, "erlang.org").
+-define(ADDR, {127,0,0,1}).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Name),
+ [{'Origin-Host', Name ++ "." ++ ?REALM},
+ {'Origin-Realm', ?REALM},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 42},
+ {'Product-Name', "OTP/diameter"},
+ {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]},
+ {application, [{alias, Name},
+ {dictionary, ?BASE},
+ {module, ?MODULE}]}]).
%% Watchdog timer as a callback.
-define(WD(T), {?MODULE, id, [T]}).
@@ -82,28 +80,28 @@
F_ <- [fun(T__) -> T__ end,
fun(T__) -> ?WD(T__) end]]]).
-%% Transport types.
--define(TRANSPORTS, [connect, accept]).
+%% Watchdog timer of the misbehaving peer.
+-define(PEER_WD, 10000).
-%% Message over the transport interface.
--define(TMSG(T), {diameter, T}).
-
-%% Receive a message within a specified time.
--define(RECV(T, Timeout),
- receive T -> now()
- after Timeout -> ?ERROR({timeout, Timeout})
+%% Receive a watchdog event within a specified time.
+-define(EVENT(T, Tmo),
+ receive #diameter_event{info = T} -> now()
+ after Tmo -> ?ERROR({timeout, Tmo})
end).
-%% Receive a message in a given number of watchdogs, plus or minus
+%% Receive an event in a given number of watchdogs, plus or minus
%% half. Note that the call to now_diff assumes left to right
%% evaluation order.
--define(RECV(T, N, WdL, WdH),
+-define(EVENT(T, N, WdL, WdH),
[?ERROR({received, _Elapsed_, _LowerBound_, N, WdL})
|| _UpperBound_ <- [(N)*(WdH) + (WdH) div 2],
- _Elapsed_ <- [now_diff(now(), ?RECV(T, _UpperBound_))],
+ _Elapsed_ <- [now_diff(now(), ?EVENT(T, _UpperBound_))],
_LowerBound_ <- [(N)*(WdL) - (WdL) div 2],
_Elapsed_ =< _LowerBound_*1000]).
+-define(EVENT(T, N, Wd),
+ ?EVENT(T, N, Wd, Wd)).
+
%% A timeout that ensures one watchdog. The ensure only one watchdog
%% requires (Wd + 2000) + 1000 < 2*(Wd - 2000) ==> 7000 < Wd for the
%% case with random jitter.
@@ -112,7 +110,7 @@
%% ===========================================================================
suite() ->
- [{timetrap, {minutes, 6}}].%% enough for 11 watchdogs @ 30 sec plus jitter
+ [{timetrap, {minutes, 10}}].%% enough for 17 watchdogs @ 30 sec plus jitter
all() ->
[reopen].
@@ -134,52 +132,97 @@ end_per_suite(_Config) ->
%% implement a transport process that plays the role of the peer
%% Diameter node.
+%reopen(_) ->
+% reopen(connect, ?WD(10000), 1, 'DWR');
+
reopen(_) ->
- [] = ?util:run([{?MODULE, [run, [reopen, Wd, T, N, M]]}
- || Wd <- ?WD_TIMERS,
- T <- ?TRANSPORTS,
- N <- [0,1,2],
- M <- ['DWR', 'DWA', other]]).
+ [] = run([[reopen, T, Wd, N, M]
+ || Wd <- ?WD_TIMERS, %% watchdog_timer value
+ T <- [listen, connect], %% watchdog to test
+ N <- [0,1,2], %% DWR's to answer before ignoring
+ M <- ['DWR', 'DWA', 'RAA']]). %% how to induce failback
-reopen(Wd, Type, N, What) ->
- Ref = make_ref(),
+reopen(Type, Wd, N, M) ->
+ Server = start_service(),
+ Client = start_service(),
- %% The maker of transport processes.
- TPid = start({N, Wd, What, Ref}),
+ %% The peer to the transport whose watchdog is tested is given a
+ %% long watchdog timeout so that it doesn't send DWR of its own.
+ {Node, Peer} = {{[], Wd}, {[{module, ?MODULE}], ?WD(?PEER_WD)}},
- %% Act like diameter_service and start the watchdog process, which
- %% in turn starts a peer_fsm process, which in turn starts a
- %% transport process by way of start/3. Messages received by the
- %% testcase are those sent by diameter_watchdog to the service
- %% process (= process starting the watchdog).
- WPid1 = watchdog(Type, Ref, TPid, Wd),
+ {{LH,LW},{CH,CW}} = case Type of
+ listen -> {Node, Peer};
+ connect -> {Peer, Node}
+ end,
- %% Low/high watchdog timeouts.
- WdL = jitter(Wd, -2000),
- WdH = jitter(Wd, 2000),
+ LO = [{transport_module, diameter_tcp},
+ {transport_config, LH ++ [{ip, ?ADDR}, {port, 0}]},
+ {watchdog_timer, LW}],
+
+ {ok, LRef} = diameter:add_transport(Server, {listen, LO}),
+
+ [LP] = ?util:lport(tcp, LRef, 20),
+
+ CO = [{transport_module, diameter_tcp},
+ {transport_config, CH ++ [{ip, ?ADDR}, {port, 0},
+ {raddr, ?ADDR}, {rport, LP}]},
+ {watchdog_timer, CW}],
+
+ %% Use a temporary process to ensure the connecting transport is
+ %% added only once events from the listening transport are
+ %% subscribed to.
+ Pid = spawn(fun() -> receive _ -> ok end end),
+
+ [] = run([[reopen, Type, T, LRef, Pid, Wd, N, M]
+ || T <- [{listen, Server}, {connect, Client, CO}]]).
+
+%% start_service/1
+
+start_service() ->
+ Name = hostname(),
+ ok = diameter:start_service(Name, [{monitor, self()} | ?SERVICE(Name)]),
+ Name.
+
+%% reopen/7
+reopen(Type, {listen = T, SvcName}, Ref, Pid, Wd, N, M) ->
+ diameter:subscribe(SvcName),
+ Pid ! ok,
+ recv(Type, T, SvcName, Ref, Wd, N, M);
+
+reopen(Type, {connect = T, SvcName, Opts}, _, Pid, Wd, N, M) ->
+ diameter:subscribe(SvcName),
+ MRef = erlang:monitor(process, Pid),
+ receive {'DOWN', MRef, process, _, _} -> ok end,
+ {ok, Ref} = diameter:add_transport(SvcName, {T, Opts}),
+ recv(Type, T, SvcName, Ref, Wd, N, M).
+
+%% recv/7
+
+%% The watchdog to be tested.
+recv(Type, Type, _SvcName, Ref, Wd, N, M) ->
%% Connection should come up immediately as a consequence of
%% starting the watchdog process. In the accepting case this
%% results in a new watchdog on a transport waiting for a new
%% connection.
- ?RECV({connection_up, WPid1, _}, 1000),
- WPid2 = case Type of
- connect ->
- WPid1;
- accept ->
- watchdog(Type, Ref, TPid, Wd)
- end,
+ ?EVENT({watchdog, Ref, _, {initial, okay}, _}, 2000),
+ ?EVENT({up, Ref, _, _, #diameter_packet{}}, 0),
+
+ %% Low/high watchdog timeouts.
+ WdL = jitter(Wd, -2000),
+ WdH = jitter(Wd, 2000),
%% OKAY Timer expires & Failover()
%% Pending SetWatchdog() SUSPECT
%%
- %% Since our transport is replying to N DWR's before becoming
- %% silent, we should go down after N+2 watchdog_timer expirations:
- %% that is, after the first unanswered DWR. Knowing the min/max
- %% watchdog timeout values gives the time interval in which the
- %% down message is expected.
- ?RECV({connection_down, WPid1}, N+2, WdL, WdH),
+ %% The peer replies to N DWR's before becoming silent, we should
+ %% go down after N+2 watchdog_timer expirations: that is, after
+ %% the first unanswered DWR. Knowing the min/max watchdog timeout
+ %% values gives the time interval in which the event is expected.
+
+ ?EVENT({watchdog, Ref, _, {okay, suspect}, _}, N+2, WdL, WdH),
+ ?EVENT({down, Ref, _, _}, 0),
%% SUSPECT Receive DWA Pending = FALSE
%% Failback()
@@ -188,9 +231,11 @@ reopen(Wd, Type, N, What) ->
%% SUSPECT Receive non-DWA Failback()
%% SetWatchdog() OKAY
%%
- %% The transport receives a message before the expiry of another
- %% watchdog to induce failback.
- ?RECV({connection_up, WPid1}, WdH),
+ %% The peer sends a message before the expiry of another watchdog
+ %% to induce failback.
+
+ ?EVENT({watchdog, Ref, _, {suspect, okay}, _}, WdH + 2000),
+ ?EVENT({up, Ref, _, _}, 0),
%% OKAY Timer expires & SendWatchdog()
%% !Pending SetWatchdog()
@@ -199,30 +244,35 @@ reopen(Wd, Type, N, What) ->
%% OKAY Timer expires & Failover()
%% Pending SetWatchdog() SUSPECT
%%
- %% The transport is still not responding to watchdogs so the
- %% connection should go back down after either one or two watchdog
- %% expiries, depending on whether or not DWA restored the connection.
- F = choose(What == 'DWA', 2, 1),
- ?RECV({connection_down, WPid1}, F, WdL, WdH),
+ %% The peer is now ignoring all watchdogs so the connection goes
+ %% back down after either one or two watchdog expiries, depending
+ %% on whether or not DWA restored the connection.
+
+ F = choose(M == 'DWA', 2, 1),
+ ?EVENT({watchdog, Ref, _, {okay, suspect}, _}, F, WdL, WdH),
+ ?EVENT({down, Ref, _, _}, 0),
%% SUSPECT Timer expires CloseConnection()
%% SetWatchdog() DOWN
%%
+ %% Non-response brings the connection down after another timeout.
+
+ ?EVENT({watchdog, Ref, _, {suspect, down}, _}, 1, WdL, WdH),
+
%% DOWN Timer expires AttemptOpen()
%% SetWatchdog() DOWN
%%
- %% Our transport tells us when the fake connection is
- %% reestablished, which should happen after another couple of
- %% watchdog expiries, the first bringing the watchdog to state
- %% DOWN, the second triggering an attempt to reopen the
- %% connection.
- ?RECV({reopen, Ref}, 2, WdL, WdH),
-
%% DOWN Connection up NumDWA = 0
%% SendWatchdog()
%% SetWatchdog()
%% Pending = TRUE REOPEN
%%
+ %% The connection is reestablished after another timeout.
+
+ recv_reopen(Type, Ref, WdL, WdH),
+
+ %% REOPEN Receive non-DWA Throwaway() REOPEN
+ %%
%% REOPEN Receive DWA & Pending = FALSE
%% NumDWA < 2 NumDWA++ REOPEN
%%
@@ -230,312 +280,259 @@ reopen(Wd, Type, N, What) ->
%% NumDWA == 2 NumDWA++
%% Failback() OKAY
%%
- %% Now the watchdog should require three received DWA's before
- %% taking the connection back up. The first DWR is sent directly
- %% after capabilities exchange so it should take no more than two
- %% watchdog expiries.
- ?RECV({connection_up, WPid2, _}, 2, WdL, WdH).
+ %% REOPEN Timer expires & SendWatchdog()
+ %% !Pending SetWatchdog()
+ %% Pending = TRUE REOPEN
+ %%
+ %% An exchange of 3 watchdogs (the first directly after
+ %% capabilities exchange) brings the connection back up.
-%% ===========================================================================
+ ?EVENT({watchdog, Ref, _, {reopen, okay}, _}, 2, WdL, WdH),
+ ?EVENT({up, Ref, _, _, #diameter_packet{}}, 0),
-%% Start the fake transport process. From diameter's point of view
-%% it's started when diameter calls start/3. We start it before this
-%% happens since we use the same fake transport each time diameter
-%% calls start/3. The process lives and dies with the test case.
-start(Config) ->
- Pid = self(),
- spawn(fun() -> loop(init(Pid, Config)) end).
-
-%% Transport start from diameter. This may be called multiple times
-%% depending on the testcase.
-start({Type, _Ref}, #diameter_service{}, Pid) ->
- Ref = make_ref(),
- MRef = erlang:monitor(process, Pid),
- Pid ! {start, self(), Type, Ref},
- {Ref, TPid} = receive
- {Ref, _} = T ->
- T;
- {'DOWN', MRef, process, _, _} = T ->
- T
- end,
- erlang:demonitor(MRef, [flush]),
- {ok, TPid}.
+ %% Non-response brings it down again.
-%% id/1
+ ?EVENT({watchdog, Ref, _, {okay, suspect}, _}, 2, WdL, WdH),
+ ?EVENT({down, Ref, _, _}, 0),
+ ?EVENT({watchdog, Ref, _, {suspect, down}, _}, 1, WdL, WdH),
-id(T) ->
- T.
+ %% Reestablish after another watchdog.
-%% ===========================================================================
+ recv_reopen(Type, Ref, WdL, WdH),
-choose(true, X, _) -> X;
-choose(false, _, X) -> X.
+ %% REOPEN Timer expires & NumDWA = -1
+ %% Pending & SetWatchdog()
+ %% NumDWA >= 0 REOPEN
+ %%
+ %% REOPEN Timer expires & CloseConnection()
+ %% Pending & SetWatchdog()
+ %% NumDWA < 0 DOWN
+ %%
+ %% Peer is now ignoring all watchdogs go down again after 2
+ %% timeouts.
-%% run/1
-%%
-%% A more useful badmatch in case of failure.
+ ?EVENT({watchdog, Ref, _, {reopen, down}, _}, 2, WdL, WdH);
-run([F|A]) ->
- ok = try
- apply(?MODULE, F, A),
- ok
- catch
- E:R ->
- {A, E, R, erlang:get_stacktrace()}
- end.
+%% The misbehaving peer.
+recv(_, Type, SvcName, Ref, Wd, N, M) ->
+ %% First transport process.
+ ?EVENT({watchdog, Ref, _, {initial, okay}, _}, 1000),
+ ?EVENT({up, Ref, _, _, #diameter_packet{}}, 0),
+ reg(Type, Ref, SvcName, {SvcName, {Wd,N,M}}),
+ ?EVENT({watchdog, Ref, _, {okay, down}, _}, infinity),
-%% now_diff/2
+ %% Second transport process.
+ ?EVENT({watchdog, Ref, _, {_, reopen}, _}, infinity),
+ reg(Type, Ref, SvcName, 3),
+ ?EVENT({watchdog, Ref, _, {_, down}, _}, infinity),
-now_diff(T1, T2) ->
- timer:now_diff(T2, T1).
+ %% Third transport process.
+ ?EVENT({watchdog, Ref, _, {_, reopen}, _}, infinity),
+ reg(Type, Ref, SvcName, 0),
+ ?EVENT({watchdog, Ref, _, {_, down}, _}, infinity),
-%% jitter/2
+ ok.
-jitter(?WD(T), _) ->
- T;
-jitter(T,D) ->
- T+D.
+%% recv_reopen/4
-%% watchdog/4
-%%
-%% Fake the call from diameter_service. The watchdog process will send
-%% messages to the calling "service" process so our tests are that the
-%% watchdog responds as expected.
-
-watchdog(Type, Ref, TPid, Wd) ->
- Opts = [{transport_module, ?MODULE},
- {transport_config, TPid},
- {watchdog_timer, Wd}],
- {_MRef, Pid} = diameter_watchdog:start({Type, Ref},
- {false, Opts, false, ?SERVICE}),
- Pid.
+recv_reopen(connect, Ref, WdL, WdH) ->
+ ?EVENT({watchdog, Ref, _, {_, reopen}, _}, 1, WdL, WdH),
+ ?EVENT({reconnect, Ref, _}, 0);
-%% ===========================================================================
+recv_reopen(listen, Ref, _, _) ->
+ ?EVENT({watchdog, Ref, _, {_, reopen}, _}, 1, ?PEER_WD).
-%% Transport process implmentation. Fakes reception of messages by
-%% sending fakes to the parent (peer fsm) process that called start/3.
-
--record(transport,
- {type, %% connect | accept | manager
- parent, %% pid() of peer_fsm/ervice process
- open = false, %% done with capabilities exchange?
- config}).%% testcase-specific config
-
-%% init/2
-
-%% Testcase starting the manager.
-init(SvcPid, {_,_,_,_} = Config) ->
- putr(peer, [{'Origin-Host', hostname() ++ ".utan.com"},
- {'Origin-Realm', "utan.com"}]),
- #transport{type = manager,
- parent = monitor(SvcPid),
- config = Config};
-
-%% Manager starting a transport.
-init(_, {Type, ParentPid, SvcPid, TwinPid, Peer, {N,_,_,_} = Config}) ->
- putr(peer, Peer),
- putr(service, SvcPid),
- putr(count, init(Type, ParentPid, TwinPid, N)),%% number of DWR's to answer
- #transport{type = Type,
- parent = monitor(ParentPid),
- config = Config}.
-
-init(Type, ParentPid, undefined, N) ->
- connected(ParentPid, Type),
- N;
-init(_, _, TPid, _) ->
- monitor(TPid),
- 3.
-
-monitor(Pid) ->
- erlang:monitor(process, Pid),
- Pid.
+%% reg/4
+%%
+%% Lookup the pid of the transport process and publish a term for
+%% send/2 to lookup.
+reg(Type, Ref, SvcName, T) ->
+ TPid = tpid(Type, Ref, diameter:service_info(SvcName, transport)),
+ true = diameter_reg:add_new({?MODULE, TPid, T}).
+
+%% tpid/3
+
+tpid(connect, Ref, [[{ref, Ref},
+ {type, connect},
+ {options, _},
+ {watchdog, _},
+ {peer, _},
+ {apps, _},
+ {caps, _},
+ {port, [{owner, TPid} | _]}
+ | _]]) ->
+ TPid;
+
+tpid(listen, Ref, [[{ref, Ref},
+ {type, listen},
+ {options, _},
+ {accept, As}
+ | _]]) ->
+ [[{watchdog, _},
+ {peer, _},
+ {apps, _},
+ {caps, _},
+ {port, [{owner, TPid} | _]}
+ | _]]
+ = lists:filter(fun([{watchdog, {_,_,S}} | _]) ->
+ S == okay orelse S == reopen
+ end,
+ As),
+ TPid.
-%% Generate a unique hostname for the faked peer.
-hostname() ->
- lists:flatten(io_lib:format("~p-~p-~p", tuple_to_list(now()))).
+%% ===========================================================================
-%% loop/1
-
-loop(S) ->
- loop(msg(receive T -> T end, S)).
-
-msg(T,S) ->
- case transition(T,S) of
- ok ->
- S;
- #transport{} = NS ->
- NS;
- {stop, Reason} ->
- x(Reason)
- end.
-
-x(Reason) ->
- exit(Reason).
-
-%% transition/2
-
-%% Manager is being asked for a new transport process.
-transition({start, Pid, Type, Ref}, #transport{type = manager,
- parent = SvcPid,
- config = Config}) ->
- TPid = start({Type, Pid, SvcPid, getr(transport), getr(peer), Config}),
- Pid ! {Ref, TPid},
- putr(transport, TPid),
+listen(PortNr, Opts) ->
+ gen_tcp:listen(PortNr, Opts).
+
+accept(LSock) ->
+ gen_tcp:accept(LSock).
+
+connect(Addr, Port, Opts) ->
+ gen_tcp:connect(Addr, Port, Opts).
+
+setopts(Sock, Opts) ->
+ inet:setopts(Sock, Opts).
+
+send(Sock, Bin) ->
+ send(getr(config), Sock, Bin).
+
+%% send/3
+
+%% First outgoing message from a new transport process is CER/CEA.
+%% Remaining outgoing messages are either DWR or DWA.
+send(undefined, Sock, Bin) ->
+ putr(config, init),
+ gen_tcp:send(Sock, Bin);
+
+%% Outgoing DWR: fake reception of DWA. Use the fact that AVP values
+%% are ignored. This is to ensure that the peer's watchdog state
+%% transitions are only induced by responses to messages it sends.
+send(_, Sock, <<_:32, 1:1, _:7, 280:24, _:32, EId:32, HId:32, _/binary>>) ->
+ Pkt = #diameter_packet{header = #diameter_header{version = 1,
+ end_to_end_id = EId,
+ hop_by_hop_id = HId},
+ msg = ['DWA', {'Result-Code', 2001},
+ {'Origin-Host', "XXX"},
+ {'Origin-Realm', ?REALM}]},
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Pkt),
+ self() ! {tcp, Sock, Bin},
ok;
-%% Peer fsm or testcase process has died.
-transition({'DOWN', _, process, Pid, _} = T, #transport{parent = Pid}) ->
- {stop, T};
-
-%% Twin transport process has gone down. In the connect case, the
-%% transport isn't started until this happens in the first place so
-%% connect immediately. In the accept case, fake the peer reconnecting
-%% only after another watchdog expiry.
-transition({'DOWN', _, process, _, _}, #transport{type = Type,
- config = {_, Wd, _, _}}) ->
- Tmo = case Type of
- connect ->
- 0;
- accept ->
- ?ONE_WD(Wd)
- end,
- erlang:send_after(Tmo, self(), reconnect),
+%% First outgoing DWA.
+send(init, Sock, Bin) ->
+ [{{?MODULE, _, T}, _}] = diameter_reg:wait({?MODULE, self(), '_'}),
+ putr(config, T),
+ send(Sock, Bin);
+
+%% First transport process.
+send({SvcName, {_,_,_} = T}, Sock, Bin) ->
+ [{'Origin-Host', _} = OH, {'Origin-Realm', _} = OR | _]
+ = ?SERVICE(SvcName),
+ putr(origin, [OH, OR]),
+ putr(config, T),
+ send(Sock, Bin);
+
+%% Discard DWA, failback after another timeout in the peer.
+send({Wd, 0 = No, Msg}, Sock, Bin) ->
+ Origin = getr(origin),
+ spawn(fun() -> failback(?ONE_WD(Wd), Msg, Sock, Bin, Origin) end),
+ putr(config, No),
ok;
-transition(reconnect, #transport{type = Type,
- parent = Pid,
- config = {_,_,_,Ref}}) ->
- getr(service) ! {reopen, Ref},
- connected(Pid, Type),
- ok;
+%% Send DWA while we're in the mood (aka 0 < N).
+send({Wd, N, Msg}, Sock, Bin) ->
+ putr(config, {Wd, N-1, Msg}),
+ gen_tcp:send(Sock, Bin);
-%% Peer fsm process is sending CER: fake the peer's CEA.
-transition(?TMSG({send, Bin}), #transport{type = connect,
- open = false,
- parent = Pid}
- = S) ->
- {Code, Flags, _} = ?BASE:msg_header('CER'),
- <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
- Hdr = make_header(Bin),
- recv(Pid, {Hdr, make_cea()}),
- S#transport{open = true};
-
-%% Peer fsm process is sending CEA.
-transition(?TMSG({send, Bin}), #transport{type = accept,
- open = false}
- = S) ->
- {Code, Flags, _} = ?BASE:msg_header('CEA'),
- <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
- S#transport{open = true};
-
-%% Watchdog is sending DWR or DWA.
-transition(?TMSG({send, Bin}), #transport{open = true} = S) ->
- {Code, _, _} = ?BASE:msg_header('DWR'),
- {Code, _, _} = ?BASE:msg_header('DWA'),
- <<_:32, R:1, 0:7, Code:24, _:96, _/binary>> = Bin,
- Hdr = make_header(Bin),
- dwa(1 == R, S, Hdr),
+%% Discard DWA.
+send(0, _Sock, _Bin) ->
ok;
-%% We're telling ourselves to fake a received message.
-transition({recv, Msg}, #transport{parent = Pid}) ->
- recv(Pid, Msg),
- ok;
+%% Send DWA.
+send(N, Sock, <<_:32, 0:1, _:7, 280:24, _/binary>> = Bin) ->
+ putr(config, N-1),
+ gen_tcp:send(Sock, Bin).
-%% We're telling ourselves to receive a message to induce failback.
-transition(failback = T, #transport{parent = Pid}) ->
- recv(Pid, eraser(T)),
- ok.
+failback(Tmo, Msg, Sock, Bin, Origin) ->
+ timer:sleep(Tmo),
+ ok = gen_tcp:send(Sock, msg(Msg, Bin, Origin)).
-make_header(Bin) ->
- #diameter_header{end_to_end_id = E,
- hop_by_hop_id = H}
- = diameter_codec:decode_header(Bin),
- #diameter_header{end_to_end_id = E,
- hop_by_hop_id = H}.
-
-recv(Pid, Msg) ->
- Pid ! ?TMSG({recv, encode(Msg)}).
-
-%% Replace the end-to-end/hop-by-hop identifiers with those from an
-%% incoming request to which we're constructing a reply.
-encode({Hdr, [_|_] = Msg}) ->
- #diameter_header{hop_by_hop_id = HBH,
- end_to_end_id = E2E}
- = Hdr,
- #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
- <<H:12/binary, _:64, T/binary>> = Bin,
- <<H/binary, HBH:32, E2E:32, T/binary>>;
-
-encode([_|_] = Msg) ->
- #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
+%% msg/2
+
+msg('DWA', Bin, _Origin) ->
+ Bin;
+msg(Msg, _Bin, Origin) ->
+ #diameter_packet{bin = Bin}
+ = diameter_codec:encode(?BASE, msg(Msg, Origin)),
Bin.
-connected(Pid, connect) ->
- Pid ! ?TMSG({self(), connected, make_ref()});
-connected(Pid, accept) ->
- Pid ! ?TMSG({self(), connected}),
- recv(Pid, make_cer()).
+msg('DWR' = M, T) ->
+ [M | T];
-make_cer() ->
- ['CER' | getr(peer)] ++ [{'Host-IP-Address', [?REMOTEHOST]},
- {'Vendor-Id', 1028},
- {'Product-Name', "Utan"},
- {'Auth-Application-Id', [?APPL_ID]}].
+msg('RAA', T) ->
+ ['RAA', {'Session-Id', diameter:session_id("abc")},
+ {'Result-Code', 2001}
+ | T].
+%% An unexpected answer is discarded after passing through the
+%% watchdog state machine.
-make_cea() ->
- ['CER' | Rest] = make_cer(),
- ['CEA', {'Result-Code', ?SUCCESS} | Rest].
+%% ===========================================================================
-make_dwr() ->
- ['DWR' | getr(peer)].
+peer_up(_SvcName, _Peer, S) ->
+ S.
-make_dwa() ->
- ['DWR' | Rest] = make_dwr(),
- ['DWA', {'Result-Code', ?SUCCESS} | Rest].
+peer_down(_SvcName, _Peer, S) ->
+ S.
-dwa(false, _, _) -> %% outgoing was DWA ...
- ok;
-dwa(true, S, Hdr) -> %% ... or DWR
- dwa(getr(count), Hdr, S);
-
-%% React to the DWR only after another watchdog expiry. We shouldn't
-%% get another DWR while the answer is pending.
-dwa(0, Hdr, #transport{config = {_, Wd, What, _}}) ->
- erlang:send_after(?ONE_WD(Wd), self(), failback),
- putr(failback, make_msg(What, Hdr)),
- eraser(count);
-
-dwa(undefined, _, _) ->
- undefined = getr(failback), %% ensure this is after failback
- ok;
+%% ===========================================================================
-%% Reply with DWA.
-dwa(N, Hdr, #transport{parent = Pid}) ->
- putr(count, N-1),
- recv(Pid, {Hdr, make_dwa()}).
+choose(true, X, _) -> X;
+choose(false, _, X) -> X.
-%% Answer to received DWR.
-make_msg('DWA', Hdr) ->
- {Hdr, make_dwa()};
+%% id/1
+%%
+%% Jitter callback.
-%% DWR from peer.
-make_msg('DWR', _) ->
- make_dwr();
+id(T) ->
+ T.
-%% An unexpected answer is discarded after passing through the
-%% watchdog state machine.
-make_msg(other, _) ->
- ['RAA', {'Session-Id', diameter:session_id("abc")},
- {'Result-Code', 2001}
- | getr(peer)].
+%% run/1
+%%
+%% A more useful badmatch in case of failure.
+
+run(Fs) ->
+ ?util:run([{?MODULE, [run1, F]} || F <- Fs]).
+
+run1([F|A]) ->
+ ok = try
+ apply(?MODULE, F, A),
+ ok
+ catch
+ E:R ->
+ S = erlang:get_stacktrace(),
+ io:format("~p~n", [{A, E, R, S}]),
+ S
+ end.
+
+%% now_diff/2
+
+now_diff(T1, T2) ->
+ timer:now_diff(T2, T1).
+
+%% jitter/2
+
+jitter(?WD(T), _) ->
+ T;
+jitter(T,D) ->
+ T+D.
+
+%% Generate a unique hostname for the faked peer.
+hostname() ->
+ lists:flatten(io_lib:format("~p-~p-~p", tuple_to_list(now()))).
putr(Key, Val) ->
put({?MODULE, Key}, Val).
getr(Key) ->
get({?MODULE, Key}).
-
-eraser(Key) ->
- erase({?MODULE, Key}).