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

2 files changed, 140 insertions, 92 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)),