Merge branch 'maint'

4 files changed, 298 insertions, 138 deletions

diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index 3e3a6be0ef..8f9901907a 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -330,6 +330,8 @@ call(SvcName, App, Message) ->
     | {applications, [app_alias()]}
     | {capabilities, [capability()]}
     | {capabilities_cb, evaluable()}
+    | {capx_timeout, 'Unsigned32'()}
+    | {disconnect_cb, evaluable()}
     | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}}
     | {reconnect_timer, 'Unsigned32'()}
     | {private, any()}.
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 3f4945f7a6..c4320fcb99 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -48,15 +48,19 @@
 -include("diameter_internal.hrl").
 -include("diameter_gen_base_rfc3588.hrl").
 
+%% Values of Disconnect-Cause in DPR.
 -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU').
 -define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING').
+-define(BUSY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_BUSY').
 
 -define(NO_INBAND_SECURITY, 0).
 -define(TLS, 1).
 
 %% Keys in process dictionary.
 -define(CB_KEY, cb).         %% capabilities callback
+-define(DPR_KEY, dpr).       %% disconnect callback
 -define(DWA_KEY, dwa).       %% outgoing DWA
+-define(REF_KEY, ref).       %% transport_ref()
 -define(Q_KEY, q).           %% transport start queue
 -define(START_KEY, start).   %% start of connected transport
 -define(SEQUENCE_KEY, mask). %% mask for sequence numbers
@@ -68,28 +72,40 @@
 %% A 2xxx series Result-Code. Not necessarily 2001.
 -define(IS_SUCCESS(N), 2 == (N) div 1000).
 
+%% Guards.
+-define(IS_UINT32(N), (is_integer(N) andalso 0 =< N andalso 0 == N bsr 32)).
+-define(IS_TIMEOUT(N), ?IS_UINT32(N)).
+-define(IS_CAUSE(N), N == ?REBOOT; N == rebooting;
+                     N == ?GOAWAY; N == goaway;
+                     N == ?BUSY;   N == busy).
+
 %% RFC 3588:
 %%
 %%   Timeout        An application-defined timer has expired while waiting
 %%                  for some event.
 %%
 -define(EVENT_TIMEOUT, 10000).
+%% Default timeout for reception of CER/CEA.
 
-%% How long to wait for a DPA in response to DPR before simply
-%% aborting. Used to distinguish between shutdown and not but there's
-%% not really any need. Stopping a service will require a timeout if
-%% the peer doesn't answer DPR so the value should be short-ish.
+%% Default timeout for DPA in response to DPR. A bit short but the
+%% timeout used to be hardcoded. (So it could be worse.)
 -define(DPA_TIMEOUT, 1000).
 
+-type uint32() :: diameter:'Unsigned32'().
+
 -record(state,
-        {state = 'Wait-Conn-Ack'   %% state of RFC 3588 Peer State Machine
-              :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open',
+        {state %% of RFC 3588 Peer State Machine
+              :: 'Wait-Conn-Ack'  %% old code
+               | {'Wait-Conn-Ack', uint32()}
+               | recv_CER
+               | 'Wait-CEA' %% old code
+               | {'Wait-CEA', uint32(), uint32()}
+               | 'Open',
          mode :: accept | connect | {connect, reference()},
-         parent       :: pid(),
-         transport    :: pid(),
+         parent       :: pid(),  %% watchdog process
+         transport    :: pid(),  %% transport process
          service      :: #diameter_service{},
-         dpr = false  :: false | {diameter:'Unsigned32'(),
-                                  diameter:'Unsigned32'()}}).
+         dpr = false  :: false | {uint32(), uint32()}}).
                             %% | hop by hop and end to end identifiers
 
 %% There are non-3588 states possible as a consequence of 5.6.1 of the
@@ -163,19 +179,24 @@ i({WPid, Type, Opts, #diameter_service{} = Svc}) ->  %% from old code
     i({WPid, Type, Opts, {?NOMASK, [node() | nodes()], Svc}});
 
 i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps,
-                                                  capabilities = Caps}
+                                                  capabilities = LCaps}
                                 = Svc}}) ->
     [] /= Apps orelse ?ERROR({no_apps, T, Opts}),
-    putr(?DWA_KEY, dwa(Caps)),
+    putr(?DWA_KEY, dwa(LCaps)),
     {M, Ref} = T,
     diameter_stats:reg(Ref),
-    {[Ts], Rest} = proplists:split(Opts, [capabilities_cb]),
-    putr(?CB_KEY, {Ref, [F || {_,F} <- Ts]}),
+    {[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]),
+    putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}),
+    putr(?DPR_KEY, [F || {_, F} <- Ds]),
+    putr(?REF_KEY, Ref),
     putr(?SEQUENCE_KEY, Mask),
     putr(?RESTRICT_KEY, Nodes),
     erlang:monitor(process, WPid),
     {TPid, Addrs} = start_transport(T, Rest, Svc),
-    #state{parent = WPid,
+    Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT),
+    ?IS_TIMEOUT(Tmo) orelse ?ERROR({invalid, {capx_timeout, Tmo}}),
+    #state{state = {'Wait-Conn-Ack', Tmo},
+           parent = WPid,
            transport = TPid,
            mode = M,
            service = svc(Svc, Addrs)}.
@@ -188,8 +209,8 @@ i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps,
 %% watchdog start (start/2) succeeds regardless so as not to crash the
 %% service.
 
-start_transport(T, Opts, #diameter_service{capabilities = Caps} = Svc) ->
-    Addrs0 = Caps#diameter_caps.host_ip_address,
+start_transport(T, Opts, #diameter_service{capabilities = LCaps} = Svc) ->
+    Addrs0 = LCaps#diameter_caps.host_ip_address,
     start_transport(Addrs0, {T, Opts, Svc}).
 
 start_transport(Addrs0, T) ->
@@ -212,9 +233,9 @@ svc(Svc, []) ->
 svc(Svc, Addrs) ->
     readdr(Svc, Addrs).
 
-readdr(#diameter_service{capabilities = Caps0} = Svc, Addrs) ->
-    Caps = Caps0#diameter_caps{host_ip_address = Addrs},
-    Svc#diameter_service{capabilities = Caps}.
+readdr(#diameter_service{capabilities = LCaps0} = Svc, Addrs) ->
+    LCaps = LCaps0#diameter_caps{host_ip_address = Addrs},
+    Svc#diameter_service{capabilities = LCaps}.
 
 %% The 4-tuple Data returned from diameter_peer:start/1 identifies the
 %% transport module/config use to start the transport process in
@@ -313,13 +334,17 @@ eraser(Key) ->
 
 %% transition/2
 
+%% Started in old code.
+transition(T, #state{state = 'Wait-Conn-Ack' = PS} = S) ->
+    transition(T, S#state{state = {PS, ?EVENT_TIMEOUT}});
+
 %% Connection to peer.
 transition({diameter, {TPid, connected, Remote}},
            #state{transport = TPid,
                   state = PS,
                   mode = M}
            = S) ->
-    'Wait-Conn-Ack' = PS,  %% assert
+    {'Wait-Conn-Ack', _} = PS,  %% assert
     connect = M,           %%
     keep_transport(TPid),
     send_CER(S#state{mode = {M, Remote}});
@@ -331,11 +356,11 @@ transition({diameter, {TPid, connected}},
                   mode = M,
                   parent = Pid}
            = S) ->
-    'Wait-Conn-Ack' = PS,  %% assert
+    {'Wait-Conn-Ack', Tmo} = PS,  %% assert
     accept = M,            %%
     keep_transport(TPid),
     Pid ! {accepted, self()},
-    start_timer(S#state{state = recv_CER});
+    start_timer(Tmo, S#state{state = recv_CER});
 
 %% Connection established after receiving a connection_timeout
 %% message. This may be followed by an incoming message which arrived
@@ -349,7 +374,7 @@ transition({diameter, {_, connected, _}}, _) ->
 %% Connection has timed out: start an alternate.
 transition({connection_timeout = T, TPid},
            #state{transport = TPid,
-                  state = 'Wait-Conn-Ack'}
+                  state = {'Wait-Conn-Ack', _}}
            = S) ->
     exit(TPid, {shutdown, T}),
     start_next(S);
@@ -364,7 +389,7 @@ transition({diameter, {recv, Pkt}}, S) ->
 
 %% Timeout when still in the same state ...
 transition({timeout, PS}, #state{state = PS}) ->
-    stop;
+    {stop, {capx(PS), timeout}};
 
 %% ... or not.
 transition({timeout, _}, _) ->
@@ -375,25 +400,19 @@ transition({send, Msg}, #state{transport = TPid}) ->
     send(TPid, Msg),
     ok;
 
-%% Request for graceful shutdown.
-transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) ->
-    dpr(?GOAWAY, S);
-transition({shutdown, Pid}, #state{parent = Pid}) ->
-    ok;
-
-%% Application shutdown.
-transition(shutdown, #state{dpr = false} = S) ->
-    dpr(?REBOOT, S);
-transition(shutdown, _) ->  %% DPR already send: ensure expected timeout
-    dpa_timer(),
+%% Messages from old (diameter_service) code.
+transition(shutdown = T, #state{parent = Pid} = S) ->
+    transition({T, Pid, service}, S); %% Reason irrelevant: old code has no cb
+
+%% Request for graceful shutdown at remove_transport, stop_service of
+%% application shutdown.
+transition({shutdown = T, Pid}, S) ->
+    transition({T, Pid, transport}, S);
+transition({shutdown, Pid, Reason}, #state{parent = Pid, dpr = false} = S) ->
+    dpr(Reason, S);
+transition({shutdown, Pid, _}, #state{parent = Pid}) ->
     ok;
 
-%% Request to close the transport connection.
-transition({close = T, Pid}, #state{parent = Pid,
-                                    transport = TPid}) ->
-    diameter_peer:close(TPid),
-    {stop, T};
-
 %% DPA reception has timed out.
 transition(dpa_timeout, _) ->
     stop;
@@ -425,6 +444,11 @@ transition({state, Pid}, #state{state = S, transport = TPid}) ->
 
 %% Crash on anything unexpected.
 
+capx(recv_CER) ->
+    'CER';
+capx({'Wait-CEA', _, _}) ->
+    'CEA'.
+
 %% start_next/1
 
 start_next(#state{service = Svc0} = S) ->
@@ -440,18 +464,23 @@ start_next(#state{service = Svc0} = S) ->
 
 %% send_CER/1
 
-send_CER(#state{mode = {connect, Remote},
-                service = #diameter_service{capabilities = Caps},
+send_CER(#state{state = {'Wait-Conn-Ack', Tmo},
+                mode = {connect, Remote},
+                service = #diameter_service{capabilities = LCaps},
                 transport = TPid}
          = S) ->
-    OH = Caps#diameter_caps.origin_host,
+    OH = LCaps#diameter_caps.origin_host,
     req_send_CER(OH, Remote)
         orelse
-        close({already_connected, Remote, Caps}, S),
+        close({already_connected, Remote, LCaps}, S),
     CER = build_CER(S),
     ?LOG(send, 'CER'),
-    send(TPid, encode(CER)),
-    start_timer(S#state{state = 'Wait-CEA'}).
+    #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+                                               hop_by_hop_id = Hid}}
+        = Pkt
+        = encode(CER),
+    send(TPid, Pkt),
+    start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}).
 
 %% Register ourselves as connecting to the remote endpoint in
 %% question. This isn't strictly necessary since a peer implementing
@@ -463,16 +492,16 @@ send_CER(#state{mode = {connect, Remote},
 req_send_CER(OriginHost, Remote) ->
     register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}).
 
-%% start_timer/1
+%% start_timer/2
 
-start_timer(#state{state = PS} = S) ->
-    erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}),
+start_timer(Tmo, #state{state = PS} = S) ->
+    erlang:send_after(Tmo, self(), {timeout, PS}),
     S.
 
 %% build_CER/1
 
-build_CER(#state{service = #diameter_service{capabilities = Caps}}) ->
-    {ok, CER} = diameter_capx:build_CER(Caps),
+build_CER(#state{service = #diameter_service{capabilities = LCaps}}) ->
+    {ok, CER} = diameter_capx:build_CER(LCaps),
     CER.
 
 %% encode/1
@@ -482,10 +511,8 @@ encode(Rec) ->
     Hdr = #diameter_header{version = ?DIAMETER_VERSION,
                            end_to_end_id = Seq,
                            hop_by_hop_id = Seq},
-    Pkt = #diameter_packet{header = Hdr,
-                           msg = Rec},
-    #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Pkt),
-    Bin.
+    diameter_codec:encode(?BASE, #diameter_packet{header = Hdr,
+                                                  msg = Rec}).
 
 sequence() ->
     case getr(?SEQUENCE_KEY) of
@@ -553,7 +580,14 @@ discard(Reason, F, A) ->
 %% rcv/3
 
 %% Incoming CEA.
-rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) ->
+rcv('CEA',
+    #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+                                               hop_by_hop_id = Hid}}
+    = Pkt,
+    #state{state = {'Wait-CEA' = T, Hid, Eid}}
+    = S) ->
+    handle_CEA(Pkt, S#state{state = T});
+rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) ->  %% old code
     handle_CEA(Pkt, S);
 
 %% Incoming CER
@@ -573,16 +607,16 @@ rcv(N, Pkt, S)
        N == 'DPR' ->
     handle_request(N, Pkt, S);
 
-%% DPA even though we haven't sent DPR: ignore.
-rcv('DPA', _Pkt, #state{dpr = false}) ->
-    ok;
-
-%% DPA in response to DPR. We could check the sequence numbers but
-%% don't bother, just close.
-rcv('DPA' = N, _Pkt, #state{transport = TPid}) ->
+%% DPA in response to DPR and with the expected identifiers.
+rcv('DPA' = N,
+    #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+                                               hop_by_hop_id = Hid}},
+    #state{transport = TPid,
+           dpr = {Hid, Eid}}) ->
     diameter_peer:close(TPid),
     {stop, N};
 
+%% Ignore anything else, an unsolicited DPA in particular.
 rcv(_, _, _) ->
     ok.
 
@@ -800,8 +834,8 @@ a('CER', #diameter_caps{vendor_id = Vid,
             {'Product-Name', Name},
             {'Origin-State-Id', OSI}];
 
-a('DPR', #diameter_caps{origin_host = Host,
-                        origin_realm = Realm}) ->
+a('DPR', #diameter_caps{origin_host = {Host, _},
+                        origin_realm = {Realm, _}}) ->
     ['DPA', {'Origin-Host', Host},
             {'Origin-Realm', Realm}].
 
@@ -909,7 +943,9 @@ rejected(N)
 
 %% open/5
 
-open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid} = S) ->
+open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid,
+                                                  service = Svc}
+                                           = S) ->
     #diameter_caps{origin_host = {_,_} = H,
                    inband_security_id = {LS,_}}
         = Caps,
@@ -917,7 +953,9 @@ open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid} = S) ->
     tls_ack(lists:member(?TLS, LS), Caps, Type, IS, S),
     Pid ! {open, self(), H, {Caps, SupportedApps, Pkt}},
 
-    S#state{state = 'Open'}.
+    %% Replace capabilities record with local/remote pairs.
+    S#state{state = 'Open',
+            service = Svc#diameter_service{capabilities = Caps}}.
 
 %% We've advertised TLS support: tell the transport the result
 %% and expect a reply when the handshake is complete.
@@ -970,24 +1008,113 @@ dwa(#diameter_caps{origin_host = OH,
             {'Origin-State-Id', OSI}].
 
 %% dpr/2
+%%
+%% The RFC isn't clear on whether DPR should be send in a non-Open
+%% state. The Peer State Machine transitions it documents aren't
+%% exhaustive (no Stop in Wait-I-CEA for example) so assume it's up to
+%% the implementation and transition to Closed (ie. die) if we haven't
+%% yet reached Open.
+
+%% Connection is open, DPR has not been sent.
+dpr(Reason, #state{state = 'Open',
+                   dpr = false,
+                   service = #diameter_service{capabilities = Caps}}
+            = S) ->
+    case getr(?DPR_KEY) of
+        CBs when is_list(CBs) ->
+            Ref = getr(?REF_KEY),
+            Peer = {self(), Caps},
+            dpr(CBs, [Reason, Ref, Peer], S);
+        undefined ->  %% started in old code
+            send_dpr(Reason, [], S)
+    end;
 
-dpr(Cause, #state{transport = TPid,
-                  service = #diameter_service{capabilities = Caps}}
-           = S) ->
-    #diameter_caps{origin_host = OH,
-                   origin_realm = OR}
+%% Connection is open, DPR already sent.
+dpr(_, #state{state = 'Open'}) ->
+    ok;
+
+%% Connection not open.
+dpr(_Reason, _S) ->
+    stop.
+
+%% dpr/3
+%%
+%% Note that an implementation that wants to do something
+%% transport_module-specific can lookup the pid of the transport
+%% process and contact it. (eg. diameter:service_info/2)
+
+dpr([CB|Rest], [Reason | _] = Args, S) ->
+    try diameter_lib:eval([CB | Args]) of
+        {dpr, Opts} when is_list(Opts) ->
+            send_dpr(Reason, Opts, S);
+        dpr ->
+            send_dpr(Reason, [], S);
+        close = T ->
+            {stop, {disconnect_cb, T}};
+        ignore ->
+            dpr(Rest, Args, S);
+        T ->
+            No = {disconnect_cb, T},
+            diameter_lib:error_report(invalid, No),
+            {stop, No}
+    catch
+        E:R ->
+            No = {disconnect_cb, E, R, ?STACK},
+            diameter_lib:error_report(failure, No),
+            {stop, No}
+    end;
+        
+dpr([], [Reason | _], S) ->
+    send_dpr(Reason, [], S).
+
+-record(opts, {cause, timeout = ?DPA_TIMEOUT}).
+
+send_dpr(Reason, Opts, #state{transport = TPid,
+                              service = #diameter_service{capabilities = Caps}}
+                       = S) ->
+    #opts{cause = Cause, timeout = Tmo}
+        = lists:foldl(fun opt/2,
+                      #opts{cause = case Reason of
+                                        transport -> ?GOAWAY;
+                                        _         -> ?REBOOT
+                                    end,
+                            timeout = ?DPA_TIMEOUT},
+                      Opts),
+    #diameter_caps{origin_host = {OH, _},
+                   origin_realm = {OR, _}}
         = Caps,
 
-    Bin = encode(['DPR', {'Origin-Host', OH},
+    #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+                                               hop_by_hop_id = Hid}}
+        = Pkt
+        = encode(['DPR', {'Origin-Host', OH},
                          {'Origin-Realm', OR},
                          {'Disconnect-Cause', Cause}]),
-    send(TPid, Bin),
-    dpa_timer(),
+    send(TPid, Pkt),
+    dpa_timer(Tmo),
     ?LOG(send, 'DPR'),
-    S#state{dpr = diameter_codec:sequence_numbers(Bin)}.
-
-dpa_timer() ->
-    erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout).
+    S#state{dpr = {Hid, Eid}}.
+
+opt({timeout, Tmo}, Rec)
+  when ?IS_TIMEOUT(Tmo) ->
+    Rec#opts{timeout = Tmo};
+opt({cause, Cause}, Rec)
+  when ?IS_CAUSE(Cause) ->
+    Rec#opts{cause = cause(Cause)};
+opt(T, _) ->
+    ?ERROR({invalid_option, T}).
+
+cause(rebooting) -> ?REBOOT;
+cause(goaway)    -> ?GOAWAY;
+cause(busy)      -> ?BUSY;
+cause(N)
+  when ?IS_CAUSE(N) ->
+    N;
+cause(N) ->
+    ?ERROR({invalid_cause, N}).
+
+dpa_timer(Tmo) ->
+    erlang:send_after(Tmo, self(), dpa_timeout).
 
 %% register_everywhere/1
 %%
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index cffba4fc94..29046e6462 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -494,7 +494,7 @@ handle_call({info, Item}, _From, S) ->
     {reply, service_info(Item, S), S};
 
 handle_call(stop, _From, S) ->
-    shutdown(S),
+    shutdown(service, S),
     {stop, normal, ok, S};
 %% The server currently isn't guaranteed to be dead when the caller
 %% gets the reply. We deal with this in the call to the server,
@@ -681,9 +681,10 @@ upgrade_insert(#state{service = #diameter_service{pid = Pid}} = S) ->
 %%% ---------------------------------------------------------------------------
 
 terminate(Reason, #state{service_name = Name} = S) ->
+    send_event(Name, stop),
     ets:delete(?STATE_TABLE, Name),
     shutdown == Reason  %% application shutdown
-        andalso shutdown(S).
+        andalso shutdown(application, S).
 
 %%% ---------------------------------------------------------------------------
 %%% # code_change(FromVsn, State, Extra)
@@ -766,44 +767,48 @@ mod_state(Alias, ModS) ->
 %%% # shutdown/2
 %%% ---------------------------------------------------------------------------
 
-shutdown(Refs, #state{peerT = PeerT}) ->
-    ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT).
+%% remove_transport: ask watchdogs to terminate their transport.
+shutdown(Refs, #state{peerT = PeerT})
+  when is_list(Refs) ->
+    ets:foldl(fun(P,ok) -> sp(P, Refs), ok end, ok, PeerT);
 
-s(#peer{ref = Ref, pid = Pid}, Refs) ->
-    s(lists:member(Ref, Refs), Pid);
-
-s(true, Pid) ->
-    Pid ! {shutdown, self()};  %% 'DOWN' will cleanup as usual
-s(false, _) ->
-    ok.
-
-%%% ---------------------------------------------------------------------------
-%%% # shutdown/1
-%%% ---------------------------------------------------------------------------
-
-shutdown(#state{peerT = PeerT}) ->
+%% application/service shutdown: ask transports to terminate themselves.
+shutdown(Reason, #state{peerT = PeerT}) ->
     %% A transport might not be alive to receive the shutdown request
     %% but give those that are a chance to shutdown gracefully.
-    wait(fun st/2, PeerT),
+    shutdown(conn, Reason, PeerT),
     %% Kill the watchdogs explicitly in case there was no transport.
-    wait(fun sw/2, PeerT).
+    shutdown(peer, Reason, PeerT).
 
-wait(Fun, T) ->
-    diameter_lib:wait(ets:foldl(Fun, [], T)).
+%% sp/2
 
-st(#peer{op_state = {OS,_}} = P, Acc) ->
-    st(P#peer{op_state = OS}, Acc);
-st(#peer{op_state = ?STATE_UP, conn = Pid}, Acc) ->
-    Pid ! shutdown,
-    [Pid | Acc];
-st(#peer{}, Acc) ->
-    Acc.
+sp(#peer{ref = Ref, pid = Pid}, Refs) ->
+    lists:member(Ref, Refs)
+        andalso (Pid ! {shutdown, self()}).  %% 'DOWN' cleans up
+
+%% shutdown/3
+
+shutdown(Who, Reason, T) ->
+    diameter_lib:wait(ets:foldl(fun(X,A) -> shutdown(Who, X, Reason, A) end,
+                                [],
+                                T)).
+
+shutdown(conn = Who, #peer{op_state = {OS,_}} = P, Reason, Acc) ->
+    shutdown(Who, P#peer{op_state = OS}, Reason, Acc);
 
-sw(#peer{pid = Pid}, Acc)
+shutdown(conn,
+         #peer{pid = Pid, op_state = ?STATE_UP, conn = TPid},
+         Reason,
+         Acc) ->
+    TPid ! {shutdown, Pid, Reason},
+    [TPid | Acc];
+
+shutdown(peer, #peer{pid = Pid}, _Reason, Acc)
   when is_pid(Pid) ->
     exit(Pid, shutdown),
     [Pid | Acc];
-sw(#peer{}, Acc) ->
+
+shutdown(_, #peer{}, _, Acc) ->
     Acc.
 
 %%% ---------------------------------------------------------------------------
@@ -857,6 +862,7 @@ i(SvcName) ->
     lists:foreach(fun(T) -> start_fsm(T,S) end, CL),
 
     init_shared(S),
+    send_event(SvcName, start),
     S.
 
 cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts},
@@ -2171,15 +2177,13 @@ reply([Msg], Dict, TPid, Fs, Pkt)
     reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []});
 
 %% No errors or a diameter_header/avp list.
-reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es,
-                                            transport_data = TD}
-                           = ReqPkt)
+reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es} = ReqPkt)
   when [] == Es;
        is_record(hd(Msg), diameter_header) ->
     Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)),
     eval_packet(Pkt, Fs),
     incr(send, Pkt, Dict, TPid),  %% count result codes in sent answers
-    send(TPid, Pkt#diameter_packet{transport_data = TD});
+    send(TPid, Pkt);
 
 %% Or not: set Result-Code and Failed-AVP AVP's.
 reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) ->
@@ -2194,23 +2198,36 @@ eval_packet(Pkt, Fs) ->
     
 %% make_answer_packet/2
 
+%% A reply message clears the R and T flags and retains the P flag.
+%% The E flag will be set at encode. 6.2 of 3588 requires the same P
+%% flag on an answer as on the request. A #diameter_packet{} returned
+%% from a handle_request callback can circumvent this by setting its
+%% own header values.
+make_answer_packet(#diameter_packet{header = Hdr,
+                                    msg = Msg,
+                                    transport_data = TD},
+                   #diameter_packet{header = ReqHdr}) ->
+    Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
+                                  is_request = false,
+                                  is_error = undefined,
+                                  is_retransmitted = false},
+    #diameter_packet{header = fold_record(Hdr0, Hdr),
+                     msg = Msg,
+                     transport_data = TD};
+
 %% Binaries and header/avp lists are sent as-is.
-make_answer_packet(Bin, _)
+make_answer_packet(Bin, #diameter_packet{transport_data = TD})
   when is_binary(Bin) ->
-    #diameter_packet{bin = Bin};
-make_answer_packet([#diameter_header{} | _] = Msg, _) ->
-    #diameter_packet{msg = Msg};
-
-%% Otherwise a reply message clears the R and T flags and retains the
-%% P flag. The E flag will be set at encode. 6.2 of 3588 requires the
-%% same P flag on an answer as on the request.
-make_answer_packet(Msg, #diameter_packet{header = ReqHdr}) ->
-    Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
-                                 is_request = false,
-                                 is_error = undefined,
-                                 is_retransmitted = false},
-    #diameter_packet{header = Hdr,
-                     msg = Msg}.
+    #diameter_packet{bin = Bin,
+                     transport_data = TD};
+make_answer_packet([#diameter_header{} | _] = Msg,
+                   #diameter_packet{transport_data = TD}) ->
+    #diameter_packet{msg = Msg,
+                     transport_data = TD};
+
+%% Otherwise, preserve transport_data.
+make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) ->
+    make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt).
 
 %% rc/1
 
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index d814f1afe2..243ad0a986 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -48,18 +48,19 @@
 -record(watchdog,
         {%% PCB - Peer Control Block; see RFC 3539, Appendix A
          status = initial :: initial | okay | suspect | down | reopen,
-         pending = false  :: boolean(),
+         pending = false  :: boolean(),  %% DWA
          tw :: 6000..16#FFFFFFFF | {module(), atom(), list()},
                                 %% {M,F,A} -> integer() >= 0
          num_dwa = 0 :: -1 | non_neg_integer(),
                      %% number of DWAs received during reopen
          %% end PCB
-         parent = self() :: pid(),
-         transport       :: pid() | undefined,
+         parent = self() :: pid(),              %% service process
+         transport       :: pid() | undefined,  %% peer_fsm process
          tref :: reference(), %% reference for current watchdog timer
          message_data,      %% term passed into diameter_service with message
          sequence :: diameter:sequence(),     %% mask
-         restrict :: {diameter:restriction(), boolean()}}).
+         restrict :: {diameter:restriction(), boolean()},
+         shutdown = false :: boolean()}).
 
 %% start/2
 %%
@@ -168,7 +169,8 @@ handle_info(T, S) ->
     handle_info(T, upgrade(S)).
 
 upgrade(S) ->
-    #watchdog{} = list_to_tuple(tuple_to_list(S) ++ [?NOMASK, {nodes, true}]).
+    #watchdog{} = list_to_tuple(tuple_to_list(S)
+                                ++ [?NOMASK, {nodes, true}, false]).
 
 event(#watchdog{status = T}, #watchdog{status = T}) ->
     ok;
@@ -225,9 +227,10 @@ transition({shutdown, Pid}, #watchdog{parent = Pid,
     down = S,  %% sanity check
     stop;
 transition({shutdown = T, Pid}, #watchdog{parent = Pid,
-                                          transport = TPid}) ->
+                                          transport = TPid}
+                                = S) ->
     TPid ! {T, self()},
-    ok;
+    S#watchdog{shutdown = true};
 
 %% Parent process has died,
 transition({'DOWN', _, process, Pid, _Reason},
@@ -301,7 +304,10 @@ transition({open = P, TPid, _Hosts, T},
 
 transition({'DOWN', _, process, TPid, _},
            #watchdog{transport = TPid,
-                     status = initial}) ->
+                     status = S,
+                     shutdown = D})
+  when S == initial;
+       D ->
     stop;
 
 transition({'DOWN', _, process, TPid, _},
@@ -481,6 +487,14 @@ throwaway(S) ->
     throw({?MODULE, throwaway, S}).
 
 %% rcv/2
+%%
+%% The lack of Hop-by-Hop and End-to-End Identifiers checks in a
+%% received DWA is intentional. The purpose of the message is to
+%% demonstrate life but a peer that consistently bungles it by sending
+%% the wrong identifiers causes the connection to toggle between OPEN
+%% and SUSPECT, with failover and failback as result, despite there
+%% being no real problem with connectivity. Thus, relax and accept any
+%% incoming DWA as being in response to an outgoing DWR.
 
 %%   INITIAL       Receive DWA          Pending = FALSE
 %%                                      Throwaway()          INITIAL