Merge branch 'anders/diameter/message_length/OTP-10687'

* anders/diameter/message_length/OTP-10687:
  Add length suite for testing Message Length errors
  Fix test/depend.mk blunder
  Add transport_opt() length_errors
  Only start a fragment timer when there's something to flush
  Simplify and document diameter_tcp fragment timer
  Comment fix
  Remove upgrade code not needed after application restart

11 files changed, 496 insertions, 106 deletions

diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 7e50f338d3..ba9225da8b 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -975,6 +975,42 @@ configured them.</p>
 Defaults to a single callback returning <c>dpr</c>.</p>
 </item>
 
+<marker id="length_errors"/>
+<tag><c>{length_errors, exit|handle|discard}</c></tag>
+<item>
+<p>
+Specifies how to deal with errors in the Message Length field of the
+Diameter Header in an incoming message.
+An error in this context is that the length is not at least 20 bytes
+(the length of a Header), is not a multiple of 4 (a valid length) or
+is not the length of the message in question, as received over the
+transport interface documented in &man_transport;.</p>
+
+<p>
+If <c>exit</c> then a warning report is emitted and the parent of the
+transport process in question exits, which causes the transport
+process itself to exit as described in &man_transport;.
+If <c>handle</c> then the message is processed as usual, a resulting
+&app_handle_request; or &app_handle_answer; callback (if one takes
+place) indicating the <c>5015</c> error (DIAMETER_INVALID_MESSAGE_LENGTH).
+If <c>discard</c> then the message in question is silently discarded.</p>
+
+<p>
+Defaults to <c>exit</c>.</p>
+
+<note>
+<p>
+The default value reflects the fact that a transport module for a
+stream-oriented transport like TCP may not be able to recover from a
+message length error since such a transport must use the Message
+Length header to divide the incoming byte stream into individual
+Diameter messages.
+An invalid length leaves it with no reliable way to rediscover message
+boundaries, which may result in the failure of subsequent messages.
+See &man_tcp; for the behaviour of that module.</p>
+</note>
+</item>
+
 <marker id="reconnect_timer"/>
 <tag><c>{reconnect_timer, Tc}</c></tag>
 <item>
diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml
index 5e3fd5eaf1..df140b16b9 100644
--- a/lib/diameter/doc/src/diameter_sctp.xml
+++ b/lib/diameter/doc/src/diameter_sctp.xml
@@ -15,7 +15,7 @@
 <erlref>
 <header>
 <copyright>
-<year>2011</year><year>2012</year>
+<year>2011</year><year>2013</year>
 <holder>Ericsson AB. All Rights Reserved.</holder>
 </copyright>
 <legalnotice>
@@ -81,7 +81,6 @@ and implements the behaviour documented in
 The start function required by &man_transport;.</p>
 
 <p>
-The only diameter_sctp-specific argument is the options list.
 Options <c>raddr</c> and <c>rport</c> specify the remote address
 and port for a connecting transport and not valid for a listening
 transport: the former is required while latter defaults to 3868 if
diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml
index fe2389d57d..01c781d553 100644
--- a/lib/diameter/doc/src/diameter_tcp.xml
+++ b/lib/diameter/doc/src/diameter_tcp.xml
@@ -93,7 +93,8 @@ before configuring TLS capability on diameter transports.</p>
 <v>Reason = term()</v>
 <v>OwnOpt = {raddr, &ip_address;}
           | {rport, integer()}
-          | {port, integer()}</v>
+          | {port, integer()}
+          | {fragment_timer, infinity | 0..16#FFFFFFFF}</v>
 <v>SslOpt = {ssl_options, true | list()}</v>
 <v>TcpOpt = term()</v>
 </type>
@@ -103,7 +104,6 @@ before configuring TLS capability on diameter transports.</p>
 The start function required by &man_transport;.</p>
 
 <p>
-The only diameter_tcp-specific argument is the options list.
 Options <c>raddr</c> and <c>rport</c> specify the remote address
 and port for a connecting transport and are not valid for a listening
 transport.
@@ -112,7 +112,18 @@ that should support TLS: a value of <c>true</c> results in a
 TLS handshake immediately upon connection establishment while
 <c>list()</c> specifies options to be passed to &ssl_connect2; or
 &ssl_accept2;
-after capabilities exchange if TLS is negotiated.
+after capabilities exchange if TLS is negotiated.</p>
+
+<p>
+Option <c>fragment_timer</c> specifies the timeout, in milliseconds,
+of a timer used to flush messages from the incoming byte
+stream even if the number of bytes indicated in the Message Length
+field of its Diameter Header have not yet been accumulated:
+such a message is received over the transport interface after
+two successive timeouts without the reception of additional bytes.
+Defaults to 1000.</p>
+
+<p>
 Remaining options are any accepted by &ssl_connect3; or
 &gen_tcp_connect3; for
 a connecting transport, or &ssl_listen2; or &gen_tcp_listen2; for
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index 6be544e950..f563d244f6 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -332,8 +332,9 @@ call(SvcName, App, Message) ->
     | {capabilities_cb, evaluable()}
     | {capx_timeout, 'Unsigned32'()}
     | {disconnect_cb, evaluable()}
-    | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}}
+    | {length_errors, exit | handle | discard}
     | {reconnect_timer, 'Unsigned32'()}
+    | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}}
     | {private, any()}.
 
 %% Predicate passed to remove_transport/2
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index ad26f230ef..66342f7b62 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -18,10 +18,10 @@
 %%
 
 %%
-%% This module implements (as a process) the RFC 3588 Peer State
+%% This module implements (as a process) the RFC 3588/6733 Peer State
 %% Machine modulo the necessity of adapting the peer election to the
-%% fact that we don't know the identity of a peer until we've
-%% received a CER/CEA from it.
+%% fact that we don't know the identity of a peer until we've received
+%% a CER/CEA from it.
 %%
 
 -module(diameter_peer_fsm).
@@ -107,8 +107,9 @@
          transport    :: pid(),     %% transport process
          dictionary   :: module(),  %% common dictionary
          service      :: #diameter_service{},
-         dpr = false  :: false | {uint32(), uint32()}}).
+         dpr = false  :: false | {uint32(), uint32()},
                             %% | hop by hop and end to end identifiers
+         length_errors :: exit | handle | discard}).
 
 %% There are non-3588 states possible as a consequence of 5.6.1 of the
 %% standard and the corresponding problem for incoming CEA's: we don't
@@ -191,15 +192,22 @@ i({Ack, WPid, {M, Ref} = T, Opts, {Mask,
     putr(?REF_KEY, Ref),
     putr(?SEQUENCE_KEY, Mask),
     putr(?RESTRICT_KEY, Nodes),
-    {TPid, Addrs} = start_transport(T, Rest, Svc),
+
     Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT),
     ?IS_TIMEOUT(Tmo) orelse ?ERROR({invalid, {capx_timeout, Tmo}}),
+    OnLengthErr = proplists:get_value(length_errors, Opts, exit),
+    lists:member(OnLengthErr, [exit, handle, discard])
+        orelse ?ERROR({invalid, {length_errors, OnLengthErr}}),
+
+    {TPid, Addrs} = start_transport(T, Rest, Svc),
+
     #state{state = {'Wait-Conn-Ack', Tmo},
            parent = WPid,
            transport = TPid,
            dictionary = Dict0,
            mode = M,
-           service = svc(Svc, Addrs)}.
+           service = svc(Svc, Addrs),
+           length_errors = OnLengthErr}.
 %% The transport returns its local ip addresses so that different
 %% transports on the same service can use different local addresses.
 %% The local addresses are put into Host-IP-Address avps here when
@@ -512,21 +520,6 @@ encode(Rec, Dict) ->
 
 %% recv/2
 
-%% RFC 3588 has result code 5015 for an invalid length but if a
-%% transport is detecting message boundaries using the length header
-%% then a length error will likely lead to further errors.
-
-recv(#diameter_packet{header = #diameter_header{length = Len}
-                             = Hdr,
-                      bin = Bin},
-     S)
-  when Len < 20;
-       (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) ->
-    discard(invalid_message_length, recv, [size(Bin),
-                                           bit_size(Bin) rem 8,
-                                           Hdr,
-                                           S]);
-
 recv(#diameter_packet{header = #diameter_header{} = Hdr}
      = Pkt,
      #state{parent = Pid,
@@ -541,29 +534,52 @@ recv(#diameter_packet{header = undefined,
                       bin = Bin}
      = Pkt,
      S) ->
-    recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S);
+    recv(diameter_codec:decode_header(Bin), Pkt, S);
 
-recv(Bin, S)
-  when is_binary(Bin) ->
-    recv(#diameter_packet{bin = Bin}, S);
+recv(Bin, S) ->
+    recv(#diameter_packet{bin = Bin}, S).
 
-recv(#diameter_packet{header = false} = Pkt, S) ->
-    discard(truncated_header, recv, [Pkt, S]).
+%% recv/3
 
-msg_id({_,_,_} = T, _) ->
-    T;
-msg_id(_, Hdr) ->
-    diameter_codec:msg_id(Hdr).
+recv(#diameter_header{length = Len}
+     = H,
+     #diameter_packet{bin = Bin}
+     = Pkt,
+     #state{length_errors = E}
+     = S)
+  when E == handle;
+       0 == Len rem 4, bit_size(Bin) == 8*Len ->
+    recv(Pkt#diameter_packet{header = H}, S);
+
+recv(#diameter_header{}
+     = H,
+     #diameter_packet{bin = Bin},
+     #state{length_errors = E}
+     = S) ->
+    invalid(E,
+            invalid_message_length,
+            recv,
+            [size(Bin), bit_size(Bin) rem 8, H, S]);
 
-%% Treat invalid length as a transport error and die. Especially in
-%% the TCP case, in which there's no telling where the next message
-%% begins in the incoming byte stream, keeping a crippled connection
-%% alive may just make things worse.
+recv(false, Pkt, #state{length_errors = E} = S) ->
+    invalid(E, truncated_header, recv, [Pkt, S]).
 
-discard(Reason, F, A) ->
+%% Note that counters here only count discarded messages.
+invalid(E, Reason, F, A) ->
     diameter_stats:incr(Reason),
+    abort(E, Reason, F, A).
+
+abort(exit, Reason, F, A) ->
     diameter_lib:warning_report(Reason, {?MODULE, F, A}),
-    throw({?MODULE, abort, Reason}).
+    throw({?MODULE, abort, Reason});
+
+abort(_, _, _, _) ->
+    ok.
+
+msg_id({_,_,_} = T, _) ->
+    T;
+msg_id(_, Hdr) ->
+    {_,_,_} = diameter_codec:msg_id(Hdr).
 
 %% rcv/3
 
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 2f486861a2..0de3825943 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -309,21 +309,35 @@ request_cb(App,
 
 %% examine/1
 %%
-%% Look for errors in a decoded message. Length errors result in
-%% decode failure in diameter_codec.
+%% Look for errors in a decoded message. It's odd/unfortunate that
+%% 501[15] aren't protocol errors.
 
-examine(#diameter_packet{header = #diameter_header{version
-                                                   = ?DIAMETER_VERSION}}
-        = Pkt) ->
-    Pkt;
+%%   DIAMETER_INVALID_MESSAGE_LENGTH 5015
+%%
+%%      This error is returned when a request is received with an invalid
+%%      message length.
+
+examine(#diameter_packet{header = #diameter_header{length = Len},
+                         bin = Bin,
+                         errors = Es}
+        = Pkt)
+  when Len < 20;
+       0 /= Len rem 4;
+       8*Len /= bit_size(Bin) ->
+    Pkt#diameter_packet{errors = [5015 | Es]};
 
 %%   DIAMETER_UNSUPPORTED_VERSION       5011
 %%      This error is returned when a request was received, whose version
 %%      number is unsupported.
 
-examine(#diameter_packet{errors = Es} = Pkt) ->
-    Pkt#diameter_packet{errors = [5011 | Es]}.
-%% It's odd/unfortunate that this isn't a protocol error.
+examine(#diameter_packet{header = #diameter_header{version = V},
+                         errors = Es}
+        = Pkt)
+  when V /= ?DIAMETER_VERSION ->
+    Pkt#diameter_packet{errors = [5011 | Es]};
+
+examine(Pkt) ->
+    Pkt.
 
 %% request_cb/8
 
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index ac79fde07e..8b8c2a6694 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -484,8 +484,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
 %% TLS over SCTP is described in RFC 3436 but has limitations as
 %% described in RFC 6083. The latter describes DTLS over SCTP, which
 %% addresses these limitations, DTLS itself being described in RFC
-%% 4347. TLS is primarily used over TCP, which the current RFC 3588
-%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP.
+%% 4347. TLS is primarily used over TCP, which RFC 6733 acknowledges
+%% by equating TLS with TLS/TCP and DTLS/SCTP.
 transition({diameter, {tls, _Ref, _Type, _Bool}}, _) ->
     stop;
 
@@ -585,8 +585,7 @@ recv({_, #sctp_assoc_change{state = comm_up,
                 socket = Sock}
      = S) ->
     Ref = getr(?REF_KEY),
-    is_reference(Ref)  %% started in new code
-        andalso publish(T, Ref, Id, Sock),
+    publish(T, Ref, Id, Sock),
     up(S#transport{assoc_id = Id,
                    streams = {IS, OS}});
 
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 596e582ab0..132088b514 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -52,7 +52,10 @@
 
 -define(DEFAULT_PORT, 3868).  %% RFC 3588, ch 2.1
 -define(LISTENER_TIMEOUT, 30000).
--define(FRAGMENT_TIMEOUT, 1000).
+-define(DEFAULT_FRAGMENT_TIMEOUT, 1000).
+
+-define(IS_UINT32(N), (is_integer(N) andalso 0 =< N andalso 0 == N bsr 32)).
+-define(IS_TIMEOUT(N), (infinity == N orelse ?IS_UINT32(N))).
 
 %% cb_info passed to ssl.
 -define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}).
@@ -72,7 +75,6 @@
         {parent             :: pid(),
          transport = self() :: pid()}).
 
--type tref()   :: reference().  %% timer reference
 -type length() :: 0..16#FFFFFF. %% message length from Diameter header
 -type size()   :: non_neg_integer().  %% accumulated binary size
 -type frag()   :: {length(), size(), binary(), list(binary())}
@@ -83,8 +85,11 @@
         {socket  :: inet:socket() | ssl:sslsocket(), %% accept/connect socket
          parent  :: pid(),          %% of process that started us
          module  :: module(),       %% gen_tcp-like module
-         frag = <<>> :: binary() | {tref(), frag()},  %% message fragment
-         ssl     :: boolean() | [term()]}). %% ssl options
+         frag = <<>> :: frag(),     %% message fragment
+         ssl     :: boolean() | [term()],       %% ssl options
+         timeout :: infinity | 0..16#FFFFFFFF,  %% fragment timeout
+         tref = false  :: false | reference(),  %% fragment timer reference
+         flush = false :: boolean()}).          %% flush fragment at timeout?
 %% The usual transport using gen_tcp can be replaced by anything
 %% sufficiently gen_tcp-like by passing a 'module' option as the first
 %% (for simplicity) transport option. The transport_module diameter_etcp
@@ -161,7 +166,12 @@ i({T, Ref, Mod, Pid, Opts, Addrs})
     %% that does nothing but kill us with the parent until call
     %% returns.
     {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}),
-    {SslOpts, Rest} = ssl(Opts),
+    {SslOpts, Rest0} = ssl(Opts),
+    {OwnOpts, Rest} = own(Rest0),
+    Tmo = proplists:get_value(fragment_timer,
+                              OwnOpts,
+                              ?DEFAULT_FRAGMENT_TIMEOUT),
+    ?IS_TIMEOUT(Tmo) orelse ?ERROR({fragment_timer, Tmo}),
     Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs),
     MPid ! {stop, self()},  %% tell the monitor to die
     M = if SslOpts -> ssl; true -> Mod end,
@@ -170,7 +180,8 @@ i({T, Ref, Mod, Pid, Opts, Addrs})
     #transport{parent = Pid,
                module = M,
                socket = Sock,
-               ssl = SslOpts};
+               ssl = SslOpts,
+               timeout = Tmo};
 %% Put the reference in the process dictionary since we now use it
 %% advertise the ssl socket after TLS upgrade.
 
@@ -196,6 +207,10 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
     erlang:monitor(process, APid),
     start_timer(#listener{socket = LSock}).
 
+own(Opts) ->
+    {Own, Rest} = proplists:split(Opts, [fragment_timer]),
+    {lists:append(Own), Rest}.
+
 ssl(Opts) ->
     {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]),
     {ssl_opts(SslOpts), Rest}.
@@ -450,6 +465,7 @@ t(T,S) ->
 
 %% Initial incoming message when we might need to upgrade to TLS:
 %% don't request another message until we know.
+
 transition({tcp, Sock, Bin}, #transport{socket = Sock,
                                         parent = Pid,
                                         frag = Head,
@@ -457,13 +473,13 @@ transition({tcp, Sock, Bin}, #transport{socket = Sock,
                                         ssl = Opts}
                              = S)
   when is_list(Opts) ->
-    case recv1(Head, Bin) of
+    case rcv(Head, Bin) of
         {Msg, B} when is_binary(Msg) ->
             diameter_peer:recv(Pid, Msg),
             S#transport{frag = B};
         Frag ->
             setopts(M, Sock),
-            S#transport{frag = Frag}
+            start_fragment_timer(S#transport{frag = Frag})
     end;
 
 %% Incoming message.
@@ -474,7 +490,7 @@ transition({P, Sock, Bin}, #transport{socket = Sock,
   when P == tcp, not B;
        P == ssl, B ->
     setopts(M, Sock),
-    recv(Bin, S);
+    start_fragment_timer(recv(Bin, S));
 
 %% Capabilties exchange has decided on whether or not to run over TLS.
 transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
@@ -485,7 +501,7 @@ transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
         = tls_handshake(Type, B, S),
     Pid ! {diameter, {tls, Ref}},
     setopts(M, Sock),
-    NS#transport{ssl = B};
+    start_fragment_timer(NS#transport{ssl = B});
 
 transition({C, Sock}, #transport{socket = Sock,
                                  ssl = B})
@@ -518,8 +534,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid,
     stop;
 
 %% Timeout for reception of outstanding packets.
-transition({timeout, TRef, flush}, S) ->
-    flush(TRef, S);
+transition({timeout, TRef, flush}, #transport{tref = TRef} = S) ->
+    flush(S#transport{tref = false});
 
 %% Request for the local port number.
 transition({resolve_port, Pid}, #transport{socket = Sock,
@@ -557,9 +573,7 @@ tls_handshake(Type, true, #transport{socket = Sock,
                           = S) ->
     {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]),
     Ref = getr(?REF_KEY),
-    is_reference(Ref)  %% started in new code
-        andalso
-        (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})),
+    true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}}),
     S#transport{socket = SSock,
                 module = ssl};
 
@@ -574,30 +588,25 @@ tls(accept, Sock, Opts) ->
 
 %% recv/2
 %%
-%% Reassemble fragmented messages and extract multple message sent
+%% Reassemble fragmented messages and extract multiple message sent
 %% using Nagle.
 
 recv(Bin, #transport{parent = Pid, frag = Head} = S) ->
-    case recv1(Head, Bin) of
+    case rcv(Head, Bin) of
         {Msg, B} when is_binary(Msg) ->
             diameter_peer:recv(Pid, Msg),
             recv(B, S#transport{frag = <<>>});
         Frag ->
-            S#transport{frag = Frag}
+            S#transport{frag = Frag,
+                        flush = false}
     end.
 
-%% recv1/2
+%% rcv/2
 
 %% No previous fragment.
-recv1(<<>>, Bin) ->
+rcv(<<>>, Bin) ->
     rcv(Bin);
 
-recv1({TRef, Head}, Bin) ->
-    erlang:cancel_timer(TRef),
-    rcv(Head, Bin).
-
-%% rcv/2
-
 %% Not even the first four bytes of the header.
 rcv(Head, Bin)
   when is_binary(Head) ->
@@ -612,22 +621,22 @@ rcv({Len, N, Head, Acc}, Bin) ->
 %% Extract a message for which we have all bytes.
 rcv(Len, N, Head, Acc)
   when Len =< N ->
-    rcv1(Len, bin(Head, Acc));
+    recv1(Len, bin(Head, Acc));
 
 %% Wait for more packets.
 rcv(Len, N, Head, Acc) ->
-    {start_timer(), {Len, N, Head, Acc}}.
+    {Len, N, Head, Acc}.
 
-%% rcv/2
+%% rcv/1
 
 %% Nothing left.
 rcv(<<>> = Bin) ->
     Bin;
 
-%% Well, this isn't good. Chances are things will go south from here
-%% but if we're lucky then the bytes we have extend to an intended
-%% message boundary and we can recover by simply discarding them,
-%% which is the result of receiving them.
+%% The Message Length isn't even sufficient for a header. Chances are
+%% things will go south from here but if we're lucky then the bytes we
+%% have extend to an intended message boundary and we can recover by
+%% simply receiving them. Make it so.
 rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
   when Len < 20 ->
     {Bin, <<>>};
@@ -635,23 +644,23 @@ rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
 %% Enough bytes to extract a message.
 rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
   when Len =< size(Bin) ->
-    rcv1(Len, Bin);
+    recv1(Len, Bin);
 
 %% Or not: wait for more packets.
 rcv(<<_:1/binary, Len:24, _/binary>> = Head) ->
-    {start_timer(), {Len, size(Head), Head, []}};
+    {Len, size(Head), Head, []};
 
 %% Not even 4 bytes yet.
 rcv(Head) ->
-    {start_timer(), Head}.
+    Head.
 
-%% rcv1/2
+%% recv1/2
 
-rcv1(Len, Bin) ->
+recv1(Len, Bin) ->
     <<Msg:Len/binary, Rest/binary>> = Bin,
     {Msg, Rest}.
 
-%% bin/[12]
+%% bin/1-2
 
 bin(Head, Acc) ->
     list_to_binary([Head | lists:reverse(Acc)]).
@@ -662,7 +671,7 @@ bin(Bin)
   when is_binary(Bin) ->
     Bin.
 
-%% start_timer/0
+%% flush/1
 
 %% An erroneously large message length may leave us with a fragment
 %% that lingers if the peer doesn't have anything more to send. Start
@@ -675,14 +684,30 @@ bin(Bin)
 %% since all messages with length problems are discarded this should
 %% also eventually lead to watchdog failover.
 
-start_timer() ->
-    erlang:start_timer(?FRAGMENT_TIMEOUT, self(), flush).
+%% No fragment to flush.
+flush(#transport{frag = <<>>} = S) ->
+    S;
 
-flush(TRef, #transport{parent = Pid, frag = {TRef, Head}} = S) ->
-    diameter_peer:recv(Pid, bin(Head)),
-    S#transport{frag = <<>>};
-flush(_, S) ->
-    S.
+%% Messages have been received since last timer expiry.
+flush(#transport{flush = false} = S) ->
+    start_fragment_timer(S#transport{flush = true});
+
+%% No messages since last expiry.
+flush(#transport{frag = Frag, parent = Pid} = S) ->
+    diameter_peer:recv(Pid, bin(Frag)),
+    S#transport{frag = <<>>}.
+
+%% start_fragment_timer/1
+%%
+%% Start a timer only if there's none running and a message to flush.
+
+start_fragment_timer(#transport{frag = B, tref = TRef} = S)
+  when B == <<>>;
+       TRef /= false ->
+    S;
+
+start_fragment_timer(#transport{timeout = Tmo} = S) ->
+    S#transport{tref = erlang:start_timer(Tmo, self(), flush)}.
 
 %% accept/2
 
diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed
index 95dca44984..7e0d6e40e5 100644
--- a/lib/diameter/test/depend.sed
+++ b/lib/diameter/test/depend.sed
@@ -38,4 +38,4 @@
 s@^-include("@@
 s@".*@@
 G
-s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@
+s@^\(.*\)\n\(.*\)@\2.$(EMULATOR): \1@
diff --git a/lib/diameter/test/diameter_length_SUITE.erl b/lib/diameter/test/diameter_length_SUITE.erl
new file mode 100644
index 0000000000..4e413e6a42
--- /dev/null
+++ b/lib/diameter/test/diameter_length_SUITE.erl
@@ -0,0 +1,288 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013. 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
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of transport_opt() length_errors.
+%%
+
+-module(diameter_length_SUITE).
+
+-export([suite/0,
+         all/0,
+         groups/0,
+         init_per_suite/1,
+         end_per_suite/1,
+         init_per_group/2,
+         end_per_group/2,
+         init_per_testcase/2,
+         end_per_testcase/2]).
+
+%% testcases
+-export([start/1,
+         send/1,
+         stop/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+         peer_down/3,
+         pick_peer/6,
+         prepare_request/5,
+         handle_answer/6,
+         handle_error/6,
+         handle_request/3]).
+
+-include("diameter.hrl").
+-include("diameter_gen_base_rfc3588.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(CLIENT, "CLIENT").
+-define(SERVER, "SERVER").
+-define(REALM, "erlang.org").
+-define(HOST(Host, Realm), Host ++ [$.|Realm]).
+-define(DICT, diameter_gen_base_rfc3588).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Name),
+        [{'Origin-Host', Name ++ "." ++ ?REALM},
+         {'Origin-Realm', ?REALM},
+         {'Host-IP-Address', [{127,0,0,1}]},
+         {'Vendor-Id', 12345},
+         {'Product-Name', "OTP/diameter"},
+         {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]},
+         {application, [{dictionary, ?DICT},
+                        {module, ?MODULE},
+                        {answer_errors, callback}]}]).
+
+-define(SUCCESS,
+        ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
+-define(MISSING_AVP,
+        ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_MISSING_AVP').
+-define(INVALID_MESSAGE_LENGTH,
+        ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_MESSAGE_LENGTH').
+
+-define(LOGOUT,
+        ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+
+-define(GROUPS, [exit, handle, discard]).
+
+-define(L, atom_to_list).
+
+%% ===========================================================================
+
+suite() ->
+    [{timetrap, {seconds, 60}}].
+
+all() ->
+    [{group, G} || G <- ?GROUPS].
+
+groups() ->
+    [{G, [], [start, send, stop]} || G <- ?GROUPS].
+
+init_per_suite(Config) ->
+    ok = diameter:start(),
+    Config.
+
+end_per_suite(_Config) ->
+    ok = diameter:stop().
+
+init_per_group(Group, Config) ->
+    [{group, Group} | Config].
+
+end_per_group(_, _) ->
+    ok.
+
+init_per_testcase(_Name, Config) ->
+    Config.
+
+end_per_testcase(_, _) ->
+    ok.
+
+origin(exit)    -> 0;
+origin(handle)  -> 1;
+origin(discard) -> 2;
+
+origin(0) -> exit;
+origin(1) -> handle;
+origin(2) -> discard.
+
+%% ===========================================================================
+
+%% start/1
+
+start(Config) ->
+    Group = proplists:get_value(group, Config),
+    ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group))),
+    ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)),
+    LRef = ?util:listen(?SERVER,
+                        tcp,
+                        [{length_errors, Group}]),
+    ?util:connect(?CLIENT,
+                  tcp,
+                  LRef,
+                  [{capabilities, [{'Origin-State-Id', origin(Group)}]}]).
+
+%% stop/1
+
+stop(_Config) ->
+    ok = diameter:remove_transport(?CLIENT, true),
+    ok = diameter:remove_transport(?SERVER, true),
+    ok = diameter:stop_service(?SERVER),
+    ok = diameter:stop_service(?CLIENT).
+
+%% send/1
+
+%% Server transport exits on messages of insuffient length.
+send(exit) ->
+    %% Transport exit is followed by failover but there's only one
+    %% transport to choose from.
+    {error, failover} = call(4);
+
+%% Server transport receives messages of insufficient length.
+send(handle) ->
+    %% Message Length too large: diameter_tcp flushes the request
+    %% when no additional bytes arrive.
+    #diameter_base_STA{'Result-Code' = ?INVALID_MESSAGE_LENGTH}
+        = call(4),
+    %% Another request answered as it should.
+    #diameter_base_STA{'Result-Code' = ?SUCCESS}
+        = call(0),
+    %% Message Length conveniently small: the trailing optional
+    %% Origin-State-Id isn't included in the received request.
+    #diameter_base_STA{'Result-Code' = ?SUCCESS}
+        = call(-12),
+    %% Server receives Origin-State-Id AVP as the first 12 bytes of
+    %% the next request: AVP <<Code:32, Flags:8, Len:24, Data:32>> is
+    %% interpreted as header <<Version:8, Len:24, Flags:8, Code:24,
+    %% ApplId: 32>>. In particular, the AVP Length 12 = 00001100 is
+    %% interpreted as Command Flags, so R=0 and the request is
+    %% interpreted as an unsolicited answer. Increase Message Length
+    %% to have the server receive all bytes sent thusfar.
+    {error, timeout}
+        = call(12),
+    %% Another request answered as it should.
+    #diameter_base_STA{'Result-Code' = ?SUCCESS}
+        = call(0),
+    %% Shorten Message Length so much that that the server doesn't
+    %% receive the required Termination-Cause AVP.
+    #diameter_base_STA{'Result-Code' = ?MISSING_AVP}
+        = call(-24);
+
+%% Server transport discards message of insufficient length.
+send(discard) ->
+    %% First request times out when the server discards it but a
+    %% second succeeds since the transport remains up.
+    {error, timeout}
+        = call(4),
+    #diameter_base_STA{'Result-Code' = ?SUCCESS}
+        = call(0);
+
+send(Config) ->
+    Group = proplists:get_value(group, Config),
+    put({?MODULE, group}, Group),
+    send(Group).
+
+%% ===========================================================================
+
+call(Delta) ->
+    Group = get({?MODULE, group}),
+    diameter:call(?CLIENT,
+                  ?DICT,
+                  #diameter_base_STR
+                  {'Termination-Cause' = ?LOGOUT,
+                   'Auth-Application-Id' = ?DIAMETER_APP_ID_COMMON,
+                   'Origin-State-Id' = [7]},
+                  [{extra, [Group, Delta]}]).
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+    State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+    State.
+
+%% pick_peer/6
+
+pick_peer([Peer], _, ?CLIENT, _State, _Group, _Delta) ->
+    {ok, Peer}.
+
+%% prepare_request/5
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, _Group, Delta) ->
+    {send, resize(Delta, prepare(Pkt, Caps))}.
+
+prepare(#diameter_packet{msg = Req0} = Pkt, Caps) ->
+    #diameter_caps{origin_host  = {OH, _},
+                   origin_realm = {OR, DR}}
+        = Caps,
+    Req = Req0#diameter_base_STR{'Session-Id' = diameter:session_id(OH),
+                                 'Origin-Host' = OH,
+                                 'Origin-Realm' = OR,
+                                 'Destination-Realm' = DR},
+    diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}).
+
+resize(0, Pkt) ->
+    Pkt;
+resize(Delta, #diameter_packet{bin = Bin} = Pkt) ->
+    Pkt#diameter_packet{bin = resize(Delta, Bin)};
+
+resize(Delta, <<V, Len:24, T/binary>>) ->
+    <<V, (Len + Delta):24, T/binary>>.
+
+%% handle_answer/6
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Group, _Delta) ->
+    Pkt#diameter_packet.msg.
+
+%% handle_error/6
+
+handle_error(Reason, _Req, ?CLIENT, _Peer, _Group, _Delta) ->
+    {error, Reason}.
+
+%% handle_request/3
+
+handle_request(Pkt, ?SERVER, {_Ref, Caps}) ->
+    #diameter_caps{origin_host  = {OH, _},
+                   origin_realm = {OR, _},
+                   origin_state_id = {_,[Id]}}
+        = Caps,
+    answer(origin(Id),
+           Pkt,
+           #diameter_base_STA{'Result-Code' = ?SUCCESS,
+                              'Session-Id' = diameter:session_id(OH),
+                              'Origin-Host' = OH,
+                              'Origin-Realm' = OR}).
+
+answer(Group, #diameter_packet{errors = Es}, Ans) ->
+    answer(Group, Es, Ans);
+
+answer(_, [], Ans) ->
+    {reply, Ans};
+answer(Group, [RC|_], Ans)
+  when RC == ?INVALID_MESSAGE_LENGTH, Group == handle;
+       RC /= ?INVALID_MESSAGE_LENGTH ->
+    {reply, Ans}.
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 80b1769d04..f575085843 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -2,7 +2,7 @@
 
 # %CopyrightBegin%
 #
-# Copyright Ericsson AB 2010-2012. All Rights Reserved.
+# Copyright Ericsson AB 2010-2013. 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
@@ -41,7 +41,8 @@ MODULES = \
 	diameter_tls_SUITE \
 	diameter_failover_SUITE \
 	diameter_dpr_SUITE \
-	diameter_event_SUITE
+	diameter_event_SUITE \
+	diameter_length_SUITE
 
 HRL_FILES = \
 	diameter_ct.hrl