Merge branch 'anders/diameter/tls_over_tcp/OTP-9605'

* anders/diameter/tls_over_tcp/OTP-9605:
  Move init/end_per_suite into testcases
  Skip tls testsuite if there's no openssl
  Clarify that ssl must be started for TLS support
  Add tls support at connection establishment
  Add tls testsuite
  Documentation updates
  Close transport if tls is requested over sctp
  Handle tls notification for tcp
  Lift recursion in tcp message reception up the call chain
  Add tls support to capabilities exchange

4 files changed, 313 insertions, 136 deletions

diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl
index aa5318e79d..138e76411e 100644
--- a/lib/diameter/src/app/diameter_capx.erl
+++ b/lib/diameter/src/app/diameter_capx.erl
@@ -62,6 +62,7 @@
 -define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY').
 
 -define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
 
 %% ===========================================================================
 
@@ -80,7 +81,7 @@ recv_CER(CER, Svc) ->
     try_it([fun rCER/2, CER, Svc]).
 
 -spec recv_CEA(#diameter_base_CEA{}, #diameter_service{})
-   -> tried({['Unsigned32'()], #diameter_caps{}}).
+   -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}).
 
 recv_CEA(CEA, Svc) ->
     try_it([fun rCEA/2, CEA, Svc]).
@@ -126,10 +127,11 @@ mk_caps(Caps0, Opts) ->
 set_cap({Key, _}, _) ->
     ?THROW({duplicate, Key}).
 
-cap(K, V) when K == 'Origin-Host';
-               K == 'Origin-Realm';
-               K == 'Vendor-Id';
-               K == 'Product-Name' ->
+cap(K, V)
+  when K == 'Origin-Host';
+       K == 'Origin-Realm';
+       K == 'Vendor-Id';
+       K == 'Product-Name' ->
     V;
 
 cap('Host-IP-Address', Vs)
@@ -139,11 +141,8 @@ cap('Host-IP-Address', Vs)
 cap('Firmware-Revision', V) ->
     [V];
 
-%% Not documented but accept it as long as it's what we support.
-cap('Inband-Security-Id', [0] = Vs) ->  %% NO_INBAND_SECURITY
-    Vs;
-
-cap(K, Vs) when K /= 'Inband-Security-Id', is_list(Vs) ->
+cap(_, Vs)
+  when is_list(Vs) ->
     Vs;
 
 cap(K, V) ->
@@ -161,28 +160,10 @@ ipaddr(A) ->
 %%
 %% Build a CER record to send to a remote peer.
 
-bCER(#diameter_caps{origin_host = Host,
-                    origin_realm = Realm,
-                    host_ip_address = Addrs,
-                    vendor_id = Vid,
-                    product_name = Name,
-                    origin_state_id = OSI,
-                    supported_vendor_id = SVid,
-                    auth_application_id = AuId,
-                    acct_application_id = AcId,
-                    vendor_specific_application_id = VSA,
-                    firmware_revision = Rev}) ->
-    #diameter_base_CER{'Origin-Host' = Host,
-                       'Origin-Realm' = Realm,
-                       'Host-IP-Address' = Addrs,
-                       'Vendor-Id' = Vid,
-                       'Product-Name' = Name,
-                       'Origin-State-Id' = OSI,
-                       'Supported-Vendor-Id' = SVid,
-                       'Auth-Application-Id' = AuId,
-                       'Acct-Application-Id' = AcId,
-                       'Vendor-Specific-Application-Id' = VSA,
-                       'Firmware-Revision' = Rev}.
+%% Use the fact that diameter_caps has the same field names as CER.
+bCER(#diameter_caps{} = Rec) ->
+    #diameter_base_CER{}
+        = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]).
 
 %% rCER/2
 %%
@@ -219,19 +200,16 @@ bCER(#diameter_caps{origin_host = Host,
 %% That is, each side sends all of its capabilities and is responsible for
 %% not sending commands that the peer doesn't support.
 
-%% TODO: Make it an option to send only common applications in CEA to
-%%       allow backwards compatibility, and also because there are likely
-%%       servers that expect this. Or maybe a callback.
-
 %% 6.10.  Inband-Security-Id AVP
 %%
 %%   NO_INBAND_SECURITY                0
 %%      This peer does not support TLS.  This is the default value, if the
 %%      AVP is omitted.
+%%
+%%   TLS                               1
+%%      This node supports TLS security, as defined by [TLS].
 
 rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
-    #diameter_base_CER{'Inband-Security-Id' = RIS}
-        = CER,
     #diameter_base_CEA{}
         = CEA
         = cea_from_cer(bCER(LCaps)),
@@ -241,56 +219,95 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
 
     {SApps,
      RCaps,
-     build_CEA([] == SApps,
-               RIS,
-               lists:member(?NO_INBAND_SECURITY, RIS),
-               CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS,
-                                     'Inband-Security-Id' = []})}.
+     build_CEA(SApps,
+               LCaps,
+               RCaps,
+               CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}.
 
-%% TODO: 5.3 of RFC3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
+%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
 %%       in the CEA and SHOULD disconnect the transport. However, we have
 %%       no way to guarantee the send before disconnecting.
 
-build_CEA(true, _, _, CEA) ->
+build_CEA([], _, _, CEA) ->
     CEA#diameter_base_CEA{'Result-Code' = ?NOAPP};
-build_CEA(false, [_|_], false, CEA) ->
-    CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY};
-build_CEA(false, [_|_], true, CEA) ->
-    CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]};
-build_CEA(false, [], false, CEA) ->
-    CEA.
+
+build_CEA(_, LCaps, RCaps, CEA) ->
+    case common_security(LCaps, RCaps) of
+        [] ->
+            CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY};
+        [_] = IS ->
+            CEA#diameter_base_CEA{'Inband-Security-Id' = IS}
+    end.
+
+%% common_security/2
+
+common_security(#diameter_caps{inband_security_id = LS},
+                #diameter_caps{inband_security_id = RS}) ->
+    cs(LS, RS).
+
+%% Unspecified is equivalent to NO_INBAND_SECURITY.
+cs([], RS) ->
+    cs([?NO_INBAND_SECURITY], RS);
+cs(LS, []) ->
+    cs(LS, [?NO_INBAND_SECURITY]);
+
+%% Agree on TLS if both parties support it. When sending CEA, this is
+%% to ensure the peer is clear that we will be expecting a TLS
+%% handshake since there is no ssl:maybe_accept that would allow the
+%% peer to choose between TLS or not upon reception of our CEA. When
+%% receiving CEA it deals with a server that isn't explicit about its choice.
+%% TODO: Make the choice configurable.
+cs(LS, RS) ->
+    Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS),
+                                              ordsets:from_list(RS))),
+    case lists:member(?TLS, Is) of
+        true ->
+            [?TLS];
+        false when [] == Is ->
+            Is;
+        false ->
+            [hd(Is)]  %% probably NO_INBAND_SECURITY
+    end.
+%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and
+%% TLS but don't enforce this. In theory this allows some other
+%% security mechanism we don't have to know about, although in
+%% practice something there may be a need for more synchronization
+%% than notification by way of an event subscription offers.
 
 %% cea_from_cer/1
 
+%% CER is a subset of CEA, the latter adding Result-Code and a few
+%% more AVP's.
 cea_from_cer(#diameter_base_CER{} = CER) ->
     lists:foldl(fun(F,A) -> to_cea(CER, F, A) end,
                 #diameter_base_CEA{},
                 record_info(fields, diameter_base_CER)).
 
 to_cea(CER, Field, CEA) ->
-    try ?BASE:'#info-'(diameter_base_CEA, {index, Field}) of
-        N ->
-            setelement(N, CEA, ?BASE:'#get-'(Field, CER))
+    try ?BASE:'#get-'(Field, CER) of
+        V -> ?BASE:'#set-'({Field, V}, CEA)
     catch
-        error: _ ->
-            CEA
+        error: _ -> CEA
     end.
-
+        
 %% rCEA/2
 
-rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc)
-  when is_record(CEA, diameter_base_CEA) ->
-    #diameter_base_CEA{'Result-Code' = RC}
-        = CEA,
-
+rCEA(#diameter_base_CEA{'Result-Code' = RC}
+     = CEA,
+     #diameter_service{capabilities = LCaps}
+     = Svc) ->
     RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}),
 
     RCaps = capx_to_caps(CEA),
     SApps = common_applications(LCaps, RCaps, Svc),
 
-    [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}),
+    [] == SApps andalso ?THROW(no_common_applications),
+
+    IS = common_security(LCaps, RCaps),
+
+    [] == IS andalso ?THROW(no_common_security),
 
-    {SApps, RCaps};
+    {SApps, IS, RCaps};
 
 rCEA(CEA, _Svc) ->
     ?THROW({invalid, CEA}).
diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl
index 0252fb3809..282fa2742f 100644
--- a/lib/diameter/src/app/diameter_peer_fsm.erl
+++ b/lib/diameter/src/app/diameter_peer_fsm.erl
@@ -52,6 +52,9 @@
 -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU').
 -define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING').
 
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
 -define(LOOP_TIMEOUT, 2000).
 
 %% RFC 3588:
@@ -195,10 +198,8 @@ handle_info(T, #state{} = State) ->
             ?LOG(stop, T),
             x(T, State)
     catch
-        throw: {?MODULE, close = C, Reason} ->
-            ?LOG(C, {Reason, T}),
-            x(Reason, State);
-        throw: {?MODULE, abort, Reason}  ->
+        throw: {?MODULE, Tag, Reason}  ->
+            ?LOG(Tag, {Reason, T}),
             {stop, {shutdown, Reason}, State}
     end.
 
@@ -281,10 +282,9 @@ transition(shutdown, _) ->  %% DPR already send: ensure expected timeout
 
 %% Request to close the transport connection.
 transition({close = T, Pid}, #state{parent = Pid,
-                                    transport = TPid}
-                             = S) ->
+                                    transport = TPid}) ->
     diameter_peer:close(TPid),
-    close(T,S);
+    {stop, T};
 
 %% DPA reception has timed out.
 transition(dpa_timeout, _) ->
@@ -418,11 +418,11 @@ rcv('CER' = N, Pkt, #state{state = recv_CER} = S) ->
 
 %% Anything but CER/CEA in a non-Open state is an error, as is
 %% CER/CEA in anything but recv_CER/Wait-CEA.
-rcv(Name, _, #state{state = PS} = S)
+rcv(Name, _, #state{state = PS})
   when PS /= 'Open';
        Name == 'CER';
        Name == 'CEA' ->
-    close({Name, PS}, S);
+    {stop, {Name, PS}};
 
 rcv(N, Pkt, S)
   when N == 'DWR';
@@ -497,15 +497,20 @@ build_answer('CER',
     #diameter_service{capabilities = #diameter_caps{origin_host = OH}}
         = Svc,
 
-    {SupportedApps, #diameter_caps{origin_host = DH} = RCaps, CEA}
+    {SupportedApps,
+     #diameter_caps{origin_host = DH} = RCaps,
+     #diameter_base_CEA{'Result-Code' = RC}
+     = CEA}
         = recv_CER(CER, S),
 
     try
-        [] == SupportedApps
-            andalso ?THROW({no_common_application, 5010}),
+        2001 == RC  %% DIAMETER_SUCCESS
+            orelse ?THROW({sent_CEA, RC}),
         register_everywhere({?MODULE, connection, OH, DH})
             orelse ?THROW({election_lost, 4003}),
-        {CEA, [fun open/4, Pkt, SupportedApps, RCaps]}
+        #diameter_base_CEA{'Inband-Security-Id' = [IS]}
+            = CEA,
+        {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]}
     catch
         ?FAILURE({Reason, RC}) ->
             {answer('CER', S) ++ [{'Result-Code', RC}],
@@ -613,7 +618,7 @@ recv_CER(CER, #state{service = Svc}) ->
 handle_CEA(#diameter_packet{header = #diameter_header{version = V},
                             bin = Bin}
            = Pkt,
-           #state{service = Svc}
+           #state{service = #diameter_service{capabilities = LCaps}}
            = S)
   when is_binary(Bin) ->
     ?LOG(recv, 'CEA'),
@@ -626,7 +631,11 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V},
 
     [] == Errors orelse close({errors, Errors}, S),
 
-    {SApps, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S),
+    {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps}
+        = recv_CEA(CEA, S),
+
+    #diameter_caps{origin_host = OH}
+        = LCaps,
 
     %% 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
@@ -634,40 +643,62 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V},
     %% receive a CER/CEA, the first that arrives wins the right to a
     %% connection with the peer.
 
-    #diameter_service{capabilities = #diameter_caps{origin_host = OH}}
-        = Svc,
-
     register_everywhere({?MODULE, connection, OH, DH})
-        orelse
-        close({'CEA', DH}, S),
+        orelse close({'CEA', DH}, S),
 
-    open(DPkt, SApps, RCaps, S).
+    open(DPkt, SApps, RCaps, {connect, IS}, S).
 
 %% recv_CEA/2
 
 recv_CEA(CEA, #state{service = Svc} = S) ->
     case diameter_capx:recv_CEA(CEA, Svc) of
-        {ok, {[], _}} ->
+        {ok, {_,_}} -> %% return from old code
+            close({'CEA', update}, S);
+        {ok, {[], _, _}} ->
             close({'CEA', no_common_application}, S);
-        {ok, T} ->
+        {ok, {_, [], _}} ->
+            close({'CEA', no_common_security}, S);
+        {ok, {_,_,_} = T} ->
             T;
         {error, Reason} ->
             close({'CEA', Reason}, S)
     end.
 
-%% open/4
+%% open/5
 
-open(Pkt, SupportedApps, RCaps, #state{parent = Pid,
-                                       service = Svc}
-                                = S) ->
-    #diameter_service{capabilities = #diameter_caps{origin_host = OH}
+open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid,
+                                                   service = Svc}
+                                            = S) ->
+    #diameter_service{capabilities = #diameter_caps{origin_host = OH,
+                                                    inband_security_id = LS}
                                    = LCaps}
         = Svc,
     #diameter_caps{origin_host = DH}
         = RCaps,
+
+    tls_ack(lists:member(?TLS, LS), Type, IS, S),
     Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}},
+
     S#state{state = 'Open'}.
 
+%% We've advertised TLS support: tell the transport the result
+%% and expect a reply when the handshake is complete.
+tls_ack(true, Type, IS, #state{transport = TPid} = S) ->
+    Ref = make_ref(),
+    MRef = erlang:monitor(process, TPid),
+    TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}},
+    receive
+        {diameter, {tls, Ref}} ->
+            erlang:demonitor(MRef, [flush]);
+        {'DOWN', MRef, process, _, _} = T ->
+            close({tls_ack, T}, S)
+    end;
+
+%% Or not. Don't send anything to the transport so that transports
+%% not supporting TLS work as before without modification.
+tls_ack(false, _, _, _) ->
+    ok.
+
 capz(#diameter_caps{} = L, #diameter_caps{} = R) ->
     #diameter_caps{}
         = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)),
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 46473e7bf1..cb024c77b1 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -411,6 +411,14 @@ transition({diameter, {send, Msg}}, S) ->
 transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
     stop;
 
+%% 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.
+transition({diameter, {tls, _Ref, _Type, _Bool}}, _) ->
+    stop;
+
 %% Listener process has died.
 transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) ->
     stop;
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 653c114471..33b9daf0d9 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -45,6 +45,9 @@
 -define(LISTENER_TIMEOUT, 30000).
 -define(FRAGMENT_TIMEOUT, 1000).
 
+%% cb_info passed to ssl.
+-define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}).
+
 %% The same gen_server implementation supports three different kinds
 %% of processes: an actual transport process, one that will club it to
 %% death should the parent die before a connection is established, and
@@ -71,8 +74,8 @@
         {socket  :: inet:socket(),  %% accept or connect socket
          parent  :: pid(),          %% of process that started us
          module  :: module(),       %% gen_tcp-like module
-         frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment
-
+         frag = <<>> :: binary() | {tref(), frag()},  %% message fragment
+         ssl     :: boolean() | [term()]}). %% ssl options
 %% 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
@@ -122,12 +125,15 @@ 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}),
-    Sock = i(T, Ref, Mod, Pid, Opts, Addrs),
+    {SslOpts, Rest} = ssl(Opts),
+    Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs),
     MPid ! {stop, self()},  %% tell the monitor to die
-    setopts(Mod, Sock),
+    M = if SslOpts -> ssl; true -> Mod end,
+    setopts(M, Sock),
     #transport{parent = Pid,
-               module = Mod,
-               socket = Sock};
+               module = M,
+               socket = Sock,
+               ssl = SslOpts};
 
 %% A monitor process to kill the transport if the parent dies.
 i(#monitor{parent = Pid, transport = TPid} = S) ->
@@ -151,7 +157,29 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
     true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
     start_timer(#listener{socket = LSock}).
 
-%% i/6
+ssl(Opts) ->
+    {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]),
+    {ssl_opts(SslOpts), Rest}.
+
+ssl_opts([]) ->
+    false;
+ssl_opts([{ssl_options, true}]) ->
+    true;
+ssl_opts([{ssl_options, Opts}])
+  when is_list(Opts) ->
+    Opts;
+ssl_opts(L) ->
+    ?ERROR({ssl_options, L}).
+
+%% i/7
+
+%% Establish a TLS connection before capabilities exchange ...
+i(Type, Ref, Mod, Pid, true, Opts, Addrs) ->
+    i(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs);
+
+%% ... or not.
+i(Type, Ref, Mod, Pid, _, Opts, Addrs) ->
+    i(Type, Ref, Mod, Pid, Opts, Addrs).
 
 i(accept, Ref, Mod, Pid, Opts, Addrs) ->
     {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}),
@@ -258,6 +286,8 @@ handle_info(T, #monitor{} = S) ->
 %% # code_change/3
 %% ---------------------------------------------------------------------------
 
+code_change(_, {transport, _, _, _, _} = S, _) ->
+    {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])};
 code_change(_, State, _) ->
     {ok, State}.
 
@@ -332,17 +362,56 @@ t(T,S) ->
 
 %% transition/2
 
+%% 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,
+                                        module = M,
+                                        ssl = Opts}
+                             = S)
+  when is_list(Opts) ->
+    case recv1(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}
+    end;
+
 %% Incoming message.
-transition({tcp, Sock, Data}, #transport{socket = Sock,
-                                         module = M}
-                              = S) ->
+transition({P, Sock, Bin}, #transport{socket = Sock,
+                                      module = M,
+                                      ssl = B}
+                           = S)
+  when P == tcp, not B;
+       P == ssl, B ->
     setopts(M, Sock),
-    recv(Data, S);
+    recv(Bin, S);
+
+%% Capabilties exchange has decided on whether or not to run over TLS.
+transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
+                                            = S) ->
+    #transport{socket = Sock,
+               module = M}
+        = NS
+        = tls_handshake(Type, B, S),
+    Pid ! {diameter, {tls, Ref}},
+    setopts(M, Sock),
+    NS#transport{ssl = B};
 
-transition({tcp_closed, Sock}, #transport{socket = Sock}) ->
+transition({C, Sock}, #transport{socket = Sock,
+                                 ssl = B})
+  when C == tcp_closed, not B;
+       C == ssl_closed, B ->
     stop;
 
-transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) ->
+transition({E, Sock, _Reason} = T, #transport{socket = Sock,
+                                              ssl = B}
+                                   = S)
+  when E == tcp_error, not B;
+       E == ssl_error, B ->
     ?ERROR({T,S});
 
 %% Outgoing message.
@@ -379,80 +448,118 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
 
 %% Crash on anything unexpected.
 
+%% tls_handshake/3
+%%
+%% In the case that no tls message is received (eg. the service hasn't
+%% been configured to advertise TLS support) we will simply never ask
+%% for another TCP message, which will force the watchdog to
+%% eventually take us down.
+
+%% TLS has already been established with the connection.
+tls_handshake(_, _, #transport{ssl = true} = S) ->
+    S;
+
+%% Capabilities exchange negotiated TLS but transport was not
+%% configured with an options list.
+tls_handshake(_, true, #transport{ssl = false}) ->
+    ?ERROR(no_ssl_options);
+
+%% Capabilities exchange negotiated TLS: upgrade the connection.
+tls_handshake(Type, true, #transport{socket = Sock,
+                                     module = M,
+                                     ssl = Opts}
+                          = S) ->
+    {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]),
+    S#transport{socket = SSock,
+                module = ssl};
+
+%% Capabilities exchange has not negotiated TLS.
+tls_handshake(_, false, S) ->
+    S.
+
+tls(connect, Sock, Opts) ->
+    ssl:connect(Sock, Opts);
+tls(accept, Sock, Opts) ->
+    ssl:ssl_accept(Sock, Opts).
+
 %% recv/2
 %%
 %% Reassemble fragmented messages and extract multple message sent
 %% using Nagle.
 
 recv(Bin, #transport{parent = Pid, frag = Head} = S) ->
-    S#transport{frag = recv(Pid, Head, Bin)}.
+    case recv1(Head, Bin) of
+        {Msg, B} when is_binary(Msg) ->
+            diameter_peer:recv(Pid, Msg),
+            recv(B, S#transport{frag = <<>>});
+        Frag ->
+            S#transport{frag = Frag}
+    end.
 
-%% recv/3
+%% recv1/2
 
 %% No previous fragment.
-recv(Pid, <<>>, Bin) ->
-    rcv(Pid, Bin);
+recv1(<<>>, Bin) ->
+    rcv(Bin);
 
-recv(Pid, {TRef, Head}, Bin) ->
+recv1({TRef, Head}, Bin) ->
     erlang:cancel_timer(TRef),
-    rcv(Pid, Head, Bin).
+    rcv(Head, Bin).
 
-%% rcv/3
+%% rcv/2
 
 %% Not even the first four bytes of the header.
-rcv(Pid, Head, Bin)
+rcv(Head, Bin)
   when is_binary(Head) ->
-    rcv(Pid, <<Head/binary, Bin/binary>>);
+    rcv(<<Head/binary, Bin/binary>>);
 
 %% Or enough to know how many bytes to extract.
-rcv(Pid, {Len, N, Head, Acc}, Bin) ->
-    rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]).
+rcv({Len, N, Head, Acc}, Bin) ->
+    rcv(Len, N + size(Bin), Head, [Bin | Acc]).
 
-%% rcv/5
+%% rcv/4
 
 %% Extract a message for which we have all bytes.
-rcv(Pid, Len, N, Head, Acc)
+rcv(Len, N, Head, Acc)
   when Len =< N ->
-    rcv(Pid, rcv1(Pid, Len, bin(Head, Acc)));
+    rcv1(Len, bin(Head, Acc));
 
 %% Wait for more packets.
-rcv(_, Len, N, Head, Acc) ->
+rcv(Len, N, Head, Acc) ->
     {start_timer(), {Len, N, Head, Acc}}.
 
 %% rcv/2
 
 %% Nothing left.
-rcv(_, <<>> = Bin) ->
+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.
-rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin)
+rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
   when Len < 20 ->
-    diameter_peer:recv(Pid, Bin),
-    <<>>;
+    {Bin, <<>>};
 
 %% Enough bytes to extract a message.
-rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin)
+rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
   when Len =< size(Bin) ->
-    rcv(Pid, rcv1(Pid, Len, Bin));
+    rcv1(Len, Bin);
 
 %% Or not: wait for more packets.
-rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) ->
+rcv(<<_:1/binary, Len:24, _/binary>> = Head) ->
     {start_timer(), {Len, size(Head), Head, []}};
 
 %% Not even 4 bytes yet.
-rcv(_, Head) ->
+rcv(Head) ->
     {start_timer(), Head}.
 
-%% rcv1/3
+%% rcv1/2
 
-rcv1(Pid, Len, Bin) ->
+rcv1(Len, Bin) ->
     <<Msg:Len/binary, Rest/binary>> = Bin,
-    diameter_peer:recv(Pid, Msg),
-    Rest.
+    {Msg, Rest}.
 
 %% bin/[12]
 
@@ -489,15 +596,18 @@ flush(_, S) ->
 
 %% accept/2
 
-accept(gen_tcp, LSock) ->
-    gen_tcp:accept(LSock);
+accept(ssl, LSock) ->
+    case ssl:transport_accept(LSock) of
+        {ok, Sock} ->
+            {ssl:ssl_accept(Sock), Sock};
+        {error, _} = No ->
+            No
+    end;
 accept(Mod, LSock) ->
     Mod:accept(LSock).
 
 %% connect/4
 
-connect(gen_tcp, Host, Port, Opts) ->
-    gen_tcp:connect(Host, Port, Opts);
 connect(Mod, Host, Port, Opts) ->
     Mod:connect(Host, Port, Opts).
 
@@ -505,6 +615,8 @@ connect(Mod, Host, Port, Opts) ->
 
 send(gen_tcp, Sock, Bin) ->
     gen_tcp:send(Sock, Bin);
+send(ssl, Sock, Bin) ->
+    ssl:send(Sock, Bin);
 send(M, Sock, Bin) ->
     M:send(Sock, Bin).
 
@@ -512,6 +624,8 @@ send(M, Sock, Bin) ->
 
 setopts(gen_tcp, Sock, Opts) ->
     inet:setopts(Sock, Opts);
+setopts(ssl, Sock, Opts) ->
+    ssl:setopts(Sock, Opts);
 setopts(M, Sock, Opts) ->
     M:setopts(Sock, Opts).
 
@@ -527,5 +641,12 @@ setopts(M, Sock) ->
 
 lport(gen_tcp, Sock) ->
     inet:port(Sock);
+lport(ssl, Sock) ->
+    case ssl:sockname(Sock) of
+        {ok, {_Addr, PortNr}} ->
+            {ok, PortNr};
+        {error, _} = No ->
+            No
+    end;
 lport(M, Sock) ->
     M:port(Sock).