Count result codes in CEA/DWA/DPA

Corresponding counters for other answer messages have been counted
previously, but those for CEA, DWA, and DPA have been missing since
diameter itself sends these messages and the implementation is as bit
more separate than it might be. The counters are keyed on values of the
following form.

  {{ApplicationId, CommandCode, 0 = Rbit}, send|recv, {'Result-Code', RC}}

3 files changed, 107 insertions, 50 deletions

diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 282276827f..ae890d67d7 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. 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
@@ -613,9 +613,13 @@ rcv('DPR' = N, Pkt, S) ->
 %% 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,
+                                               hop_by_hop_id = Hid}}
+    = Pkt,
+    #state{dictionary = Dict0,
+           transport = TPid,
            dpr = {Hid, Eid}}) ->
+
+    incr_A(recv, diameter_codec:decode(Dict0, Pkt), Dict0),
     diameter_peer:close(TPid),
     {stop, N};
 
@@ -623,6 +627,11 @@ rcv('DPA' = N,
 rcv(_, _, _) ->
     ok.
 
+%% incr_A/3
+
+incr_A(Dir, Pkt, Dict0) ->
+    diameter_traffic:incr_A(Dir, Pkt, self(), Dict0).
+
 %% send/2
 
 %% Msg here could be a #diameter_packet or a binary depending on who's
@@ -649,15 +658,18 @@ send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) ->
 
     %% An answer message clears the R and T flags and retains the P
     %% flag. The E flag is set at encode.
-    Pkt = #diameter_packet{header
-                           = H#diameter_header{version = ?DIAMETER_VERSION,
-                                               is_request = false,
-                                               is_error = undefined,
-                                               is_retransmitted = false},
-                           msg = Msg,
-                           transport_data = TD},
-
-    send(TPid, diameter_codec:encode(Dict, Pkt)),
+    Pkt0 = #diameter_packet{header
+                            = H#diameter_header{version = ?DIAMETER_VERSION,
+                                                is_request = false,
+                                                is_error = undefined,
+                                                is_retransmitted = false},
+                            msg = Msg,
+                            transport_data = TD},
+
+    Pkt = diameter_codec:encode(Dict, Pkt0),
+
+    incr_A(send, Pkt, Dict),
+    send(TPid, Pkt),
     eval(PostF, S).
 
 eval([F|A], S) ->
@@ -738,7 +750,7 @@ rejected(discard, T, _) ->
 rejected({N, Es}, T, S) ->
     {answer('CER', N, failed_avp(N, Es), S), T};
 rejected(N, T, S) ->
-    rejected({N, []}, T, S).
+    {answer('CER', N, [], S), T}.
 
 failed_avp(RC, [{RC, Avp} | _]) ->
     [{'Failed-AVP', [[{'AVP', [Avp]}]]}];
@@ -856,7 +868,7 @@ recv_CER(CER, #state{service = Svc, dictionary = Dict}) ->
             close({'CER', CER, Svc, Dict, Reason})
     end.
 
-%% handle_CEA/1
+%% handle_CEA/2
 
 handle_CEA(#diameter_packet{bin = Bin}
            = Pkt,
@@ -866,18 +878,18 @@ handle_CEA(#diameter_packet{bin = Bin}
   when is_binary(Bin) ->
     ?LOG(recv, 'CEA'),
 
-    #diameter_packet{msg = CEA}
+    #diameter_packet{}
         = DPkt
         = diameter_codec:decode(Dict0, Pkt),
 
+    RC = result_code(incr_A(recv, DPkt, Dict0)),
+
     {SApps, IS, RCaps} = recv_CEA(DPkt, S),
 
     #diameter_caps{origin_host = {OH, DH}}
         = Caps
         = capz(LCaps, RCaps),
 
-    RC = Dict0:'#get-'('Result-Code', CEA),
-
     %% Ensure that we don't already have a connection to the peer in
     %% question. This isn't the peer election of 3588 except in the
     %% sense that, since we don't know who we're talking to until we
@@ -885,6 +897,8 @@ handle_CEA(#diameter_packet{bin = Bin}
     %% connection with the peer.
 
     try
+        is_integer(RC)
+            orelse ?THROW(no_result_code),
         ?IS_SUCCESS(RC)
             orelse ?THROW(RC),
         [] == SApps
@@ -905,6 +919,11 @@ handle_CEA(#diameter_packet{bin = Bin}
 %% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002,
 %% even if this isn't required by RFC 3588.
 
+result_code({{'Result-Code', N}, _}) ->
+    N;
+result_code(_) ->
+    undefined.
+
 %% recv_CEA/2
 
 recv_CEA(#diameter_packet{header = #diameter_header{version
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 8b6f026b34..34f08a2710 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2013. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2014. 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
@@ -31,6 +31,9 @@
 %% towards diameter_watchdog
 -export([receive_message/4]).
 
+%% towards diameter_peer_fsm and diameter_watchdog
+-export([incr_A/4]).
+
 %% towards diameter_service
 -export([make_recvdata/1,
          peer_up/1,
@@ -112,6 +115,29 @@ peer_down(TPid) ->
     failover(TPid).
 
 %% ---------------------------------------------------------------------------
+%% incr_A/4
+%% ---------------------------------------------------------------------------
+
+-spec incr_A(send|recv, #diameter_packet{}, TPid, Dict0)
+   -> {Counter, non_neg_integer()}
+    | Reason
+ when TPid :: pid(),
+      Dict0 :: module(),
+      Counter :: {'Result-Code', integer()}
+               | {'Experimental-Result', integer(), integer()},
+      Reason :: atom().
+
+incr_A(Dir, Pkt, TPid, Dict0) ->
+    try
+        incr_A(Dir, Pkt, Dict0, TPid, Dict0)
+    catch
+        exit: {invalid_error_bit = E, _} ->
+            E;
+        exit: no_result_code = E ->
+            E
+    end.
+
+%% ---------------------------------------------------------------------------
 %% pending/1
 %% ---------------------------------------------------------------------------
 
@@ -609,7 +635,7 @@ reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) ->
     Pkt = encode(Dict,
                  reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0),
                  Fs),
-    incr(send, Pkt, Dict, TPid, Dict0),  %% count outgoing result codes
+    incr_A(send, Pkt, Dict, TPid, Dict0),  %% count outgoing result codes
     send(TPid, Pkt).
 
 %% reset/3
@@ -974,35 +1000,38 @@ find(Pred, [H|T]) ->
 %%    code, the missing vendor id, and a zero filled payload of the minimum
 %%    required length for the omitted AVP will be added.
 
-%% incr/4
+%% incr_A/5
 %%
 %% Increment a stats counter for result codes in incoming and outgoing
 %% answers.
 
 %% Outgoing message as binary: don't count. (Sending binaries is only
 %% partially supported.)
-incr(_, #diameter_packet{msg = undefined}, _, _, _) ->
-    ok;
+incr_A(_, #diameter_packet{msg = undefined = No}, _, _, _) ->
+    No;
 
 %% Incoming with decode errors.
-incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) ->
+incr_A(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) ->
     incr(TPid, {diameter_codec:msg_id(H), D, error});
 
 %% Incoming without errors or outgoing. Outgoing with encode errors
 %% never gets here since encode fails.
-incr(Dir, Pkt, Dict, TPid, Dict0) ->
+incr_A(Dir, Pkt, Dict, TPid, Dict0) ->
     #diameter_packet{header = #diameter_header{is_error = E}
                             = Hdr,
-                     msg = Rec}
+                     msg = Msg}
         = Pkt,
 
-    RC = int(get_avp_value(Dict, 'Result-Code', Rec)),
+    %% Exit on a missing result code.
+    T = rc_counter(Dict, Msg),
+    T == false andalso x(no_result_code, answer, [Dir, Pkt]),
+    {Ctr, RC} = T,
 
-    %% Exit on an improper Result-Code.
+    %% Or on an inappropriate value.
     is_result(RC, E, Dict0)
         orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]),
 
-    irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)).
+    incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}).
 
 %% No E-bit: can't be 3xxx.
 is_result(RC, false, _Dict0) ->
@@ -1018,16 +1047,10 @@ is_result(RC, true, _) ->
         orelse
         5000 =< RC andalso RC < 6000.
 
-irc(_, _, _, undefined) ->
-    false;
-
-irc(TPid, Hdr, Dir, Ctr) ->
-    incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}).
-
 %% incr/2
 
-incr(TPid, Counter) ->
-    diameter_stats:incr(Counter, TPid, 1).
+incr(TPid, {_, _, T} = Counter) ->
+    {T, diameter_stats:incr(Counter, TPid, 1)}.
 
 %% rc_counter/2
 
@@ -1036,14 +1059,16 @@ incr(TPid, Counter) ->
 %%   All Diameter answer messages defined in vendor-specific
 %%   applications MUST include either one Result-Code AVP or one
 %%   Experimental-Result AVP.
-%%
-%% Maintain statistics assuming one or the other, not both, which is
-%% surely the intent of the RFC.
 
-rc_counter(Dict, Rec, undefined) ->
-    rcc(get_avp_value(Dict, 'Experimental-Result', Rec));
-rc_counter(_, _, RC) ->
-    {'Result-Code', RC}.
+rc_counter(Dict, Msg) ->
+    rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))).
+
+rcc(Dict, Msg, undefined) ->
+    rcc(get_avp_value(Dict, 'Experimental-Result', Msg));
+
+rcc(_, _, N)
+  when is_integer(N) ->
+    {{'Result-Code', N}, N}.
 
 %% Outgoing answers may be in any of the forms messages can be sent
 %% in. Incoming messages will be records. We're assuming here that the
@@ -1051,12 +1076,12 @@ rc_counter(_, _, RC) ->
 
 rcc([{_,_,N} = T | _])
   when is_integer(N) ->
-    T;
+    {T,N};
 rcc({_,_,N} = T)
   when is_integer(N) ->
-    T;
+    {T,N};
 rcc(_) ->
-    undefined.
+    false.
 
 %% Extract the first good looking integer. There's no guarantee
 %% that what we're looking for has arity 1.
@@ -1383,10 +1408,16 @@ handle_answer(SvcName,
 
 handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) ->
     try
-        incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes
+        incr_A(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes
     of
         _ -> answer(Pkt, SvcName, App, Req)
     catch
+        exit: no_result_code ->
+            %% RFC 6733 requires one of Result-Code or
+            %% Experimental-Result, but the decode will have detected
+            %% a missing AVP. If both are optional in the dictionary
+            %% then this isn't a decode error: just continue on.
+            answer(Pkt, SvcName, App, Req);
         exit: {invalid_error_bit, RC} ->
             #diameter_packet{errors = Es}
                 = Pkt,
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index 9a1c8b6585..c17a3bde5d 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -472,7 +472,6 @@ encode(dwr = M, Dict0, Mask) ->
     #diameter_packet{bin = Bin} = diameter_codec:encode(Dict0, Pkt),
     Bin;
 
-
 encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD}
                    = ReqPkt) ->
     AnsPkt = #diameter_packet{header
@@ -560,13 +559,21 @@ recv(Name, Pkt, S) ->
 
 rcv('DWR', Pkt, #watchdog{transport = TPid,
                           dictionary = Dict0}) ->
-    send(TPid, {send, encode(dwa, Dict0, Pkt)}),
+    EPkt = encode(dwa, Dict0, Pkt),
+    diameter_traffic:incr_A(send, EPkt, TPid, Dict0),
+    send(TPid, {send, EPkt}),
     ?LOG(send, 'DWA');
 
+rcv('DWA', Pkt, #watchdog{transport = TPid,
+                          dictionary = Dict0}) ->
+    diameter_traffic:incr_A(recv,
+                            diameter_codec:decode(Dict0, Pkt),
+                            TPid,
+                            Dict0);
+
 rcv(N, _, _)
   when N == 'CER';
        N == 'CEA';
-       N == 'DWA';
        N == 'DPR';
        N == 'DPA' ->
     false;