Add tls support at connection establishment

This is the method added in draft-ietf-dime-rfc3588bis, whereby
a TLS handshake immediately follows connection establishment and
CER/CEA is sent over the secured connection.

3 files changed, 224 insertions, 148 deletions

diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml
index 916700927f..210ae9fdfe 100644
--- a/lib/diameter/doc/src/diameter_tcp.xml
+++ b/lib/diameter/doc/src/diameter_tcp.xml
@@ -44,8 +44,9 @@ It can be specified as the value of a transport_module option to
 marker="diameter#add_transport">diameter:add_transport/2</seealso>
 and implements the behaviour documented in
 <seealso marker="diameter_transport">diameter_transport(3)</seealso>.
-TLS security is supported, a connection being upgraded if
-TLS is negotiated during capabilities exchange.</p>
+TLS security is supported, both as an upgrade following
+capabilities exchange as specified by RFC 3588 and
+at connection establishment as in the current draft standard.</p>
 
 <marker id="start"/>
 </description>
@@ -62,14 +63,15 @@ TLS is negotiated during capabilities exchange.</p>
 <v>Type = connect | accept</v>
 <v>Ref = reference()</v>
 <v>Svc = #diameter_service{}</v>
-<v>Opt = OwnOpt | TlsOpt | TcpOpt</v>
+<v>Opt = OwnOpt | SslOpt | OtherOpt</v>
 <v>Pid = pid()</v>
 <v>LAddr = ip_address()</v>
 <v>Reason = term()</v>
 <v>OwnOpt = {raddr, ip_address()}
-          | {rport, integer()}</v>
-<v>TlsOpt = {ssl_options, list()}</v>
-<v>TcpOpt = term()</v>
+          | {rport, integer()}
+          | {port, integer()}</v>
+<v>SslOpt = {ssl_options, true | list()}</v>
+<v>OtherOpt = term()</v>
 </type>
 <desc>
 
@@ -82,19 +84,23 @@ 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.
-Option <c>ssl_options</c> specifies options to be passed
-to ssl:connect/2 of ssl:ssl_accept/2 in case capabilities exchange
-results in TLS being chosen for inband security.
-Remaining options are any accepted by gen_tcp:connect/3 for
-a connecting transport, or gen_tcp:listen/2 for a listening transport,
-with the exception of <c>binary</c>, <c>packet</c> and <c>active</c>.
+Option <c>ssl_options</c> must be specified for a transport
+that must be able to support TLS: a value of <c>true</c> results in a
+TLS handshake immediately upon connection establishment while
+list() specifies options to be passed to ssl:connect/2 of ssl:ssl_accept/2
+after capabilities exchange if TLS is negotiated.
+Remaining options are any accepted by ssl:connect/3 or gen_tcp:connect/3 for
+a connecting transport, or ssl:listen/3 or gen_tcp:listen/2 for
+a listening transport, depending on whether or not <c>{ssl_options, true}</c>
+has been specified.
+Options <c>binary</c>, <c>packet</c> and <c>active</c> cannot be specified.
 Also, option <c>port</c> can be specified for a listening transport
 to specify the local listening port, the default being the standardized
 3868 if unspecified.
 Note that option <c>ip</c> specifies the local address.</p>
 
 <p>
-The <c>ssl_options</c> option must be specified if and only if
+An <c>ssl_options</c> list must be specified if and only if
 the transport in question has specified an Inband-Security-Id
 AVP with value TLS on the relevant call to
 <seealso
@@ -104,7 +110,7 @@ marker="diameter#add_transport">add_transport/2</seealso>,
 so that the transport process will receive notification of
 whether or not to commence with a TLS handshake following capabilities
 exchange.
-Failing to specify <c>ssl_options</c> on a TLS-capable transport
+Failing to specify an options list on a TLS-capable transport
 for which TLS is negotiated will cause TLS handshake to fail.
 Failing to specify TLS capability when <c>ssl_options</c> has been
 specified will cause the transport process to wait for a notification
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index e0b68237c2..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
@@ -122,14 +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}),
-    {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]),
-    Sock = i(T, Ref, Mod, Pid, Rest, 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,
+               module = M,
                socket = Sock,
-               ssl = ssl_opts(Mod, SslOpts)};
+               ssl = SslOpts};
 
 %% A monitor process to kill the transport if the parent dies.
 i(#monitor{parent = Pid, transport = TPid} = S) ->
@@ -153,15 +157,29 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
     true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
     start_timer(#listener{socket = LSock}).
 
-ssl_opts(_, []) ->
+ssl(Opts) ->
+    {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]),
+    {ssl_opts(SslOpts), Rest}.
+
+ssl_opts([]) ->
     false;
-ssl_opts(Mod, [{ssl_options, Opts}])
+ssl_opts([{ssl_options, true}]) ->
+    true;
+ssl_opts([{ssl_options, Opts}])
   when is_list(Opts) ->
-    [{Mod, tcp, tcp_closed} | Opts];
-ssl_opts(_, L) ->
+    Opts;
+ssl_opts(L) ->
     ?ERROR({ssl_options, L}).
 
-%% i/6
+%% 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}),
@@ -437,14 +455,25 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
 %% 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) ->
-    is_list(Opts) orelse ?ERROR({tls, Opts}),
-    {ok, SSock} = tls(Type, Sock, Opts),
+    {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.
 
@@ -567,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).
 
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 466f7af138..8cf135cebf 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -18,15 +18,17 @@
 %%
 
 %%
-%% Tests of traffic between four Diameter nodes connected as follows.
+%% Tests of traffic between six Diameter nodes connected as follows.
 %%
-%%                  ---- SERVER.REALM1
+%%                  ---- SERVER.REALM1  (TLS after capabilities exchange)
 %%                /
-%%   CLIENT.REALM0 ----- SERVER.REALM2
+%%               /  ---- SERVER.REALM2  (ditto)
+%%              | /
+%%   CLIENT.REALM0 ----- SERVER.REALM3  (no security)
+%%              | \
+%%               \  ---- SERVER.REALM4  (TLS at connection establishment)
 %%                \
-%%                  ---- SERVER.REALM3
-%%
-%% The first two connections are established over TLS, the third not.
+%%                  ---- SERVER.REALM5  (ditto)
 %%
 
 -module(diameter_tls_SUITE).
@@ -43,6 +45,8 @@
 -export([send1/1,
          send2/1,
          send3/1,
+         send4/1,
+         send5/1,
          remove_transports/1,
          stop_services/1]).
 
@@ -73,6 +77,10 @@
 -define(SERVER1, "SERVER.REALM1").
 -define(SERVER2, "SERVER.REALM2").
 -define(SERVER3, "SERVER.REALM3").
+-define(SERVER4, "SERVER.REALM4").
+-define(SERVER5, "SERVER.REALM5").
+
+-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]).
 
 -define(DICT_COMMON,  ?DIAMETER_DICT_COMMON).
 
@@ -113,13 +121,12 @@
                   {capabilities, Caps}]}).
 
 -define(SUCCESS, 2001).
-
 -define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
 
 %% ===========================================================================
 
 suite() ->
-    [{timetrap, {seconds, 10}}].
+    [{timetrap, {seconds, 15}}].
 
 all() ->
     [{group, N} || {N, _, _} <- groups()]
@@ -141,24 +148,14 @@ init_per_suite(Config) ->
     ok = diameter:start(),
 
     Dir = proplists:get_value(priv_dir, Config),
-    Servers = [server(?SERVER1,
-                      inband_security([?TLS]),
-                      ssl_options(Dir, "server1")),
-               server(?SERVER2,
-                      inband_security([?NO_INBAND_SECURITY, ?TLS]),
-                      ssl_options(Dir, "server2")),
-               server(?SERVER3,
-                      [],
-                      [])],
+    Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS],
 
     ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
-
     true = diameter:subscribe(?CLIENT),
 
-    Connections = connect(?CLIENT,
-                          Servers,
-                          inband_security([?NO_INBAND_SECURITY, ?TLS]),
-                          ssl_options(Dir, "client")),
+    Opts = ssl_options(Dir, "client"),
+    Connections = [connect(?CLIENT, S, copts(N, Opts))
+                   || {S,N} <- lists:zip(Servers, ?SERVERS)],
 
     [{transports, lists:zip(Servers, Connections)} | Config].
 
@@ -172,72 +169,12 @@ end_per_suite(_Config) ->
 tc() ->
     [send1,
      send2,
-     send3].
-
-%% ===========================================================================
-
-inband_security(Ids) ->
-    [{'Inband-Security-Id', Ids}].
-
-ssl_options(Dir, Base) ->
-    {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"),
-    [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}].
-
-server(Host, Caps, Opts) ->
-    ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)),
-    {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)),
-    {LRef, portnr(LRef)}.
-
-connect(Host, {_LRef, PortNr}, Caps, Opts) ->
-    {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)),
-    ok = receive
-             #diameter_event{service = Host,
-                             info = {up, Ref, _, _, #diameter_packet{}}} ->
-                 ok
-         after 2000 ->
-                 false
-         end,
-    Ref;
-connect(Host, Ports, Caps, Opts) ->
-    [connect(Host, P, Caps, Opts) || P <- Ports].
-
-portnr(LRef) ->
-    portnr(LRef, 20).
-
-portnr(LRef, N)
-  when 0 < N ->
-    case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
-        [{T, _Pid}] ->
-            {_, _, {LRef, {_Addr, LSock}}} = T,
-            {ok, PortNr} = inet:port(LSock),
-            PortNr;
-        [] ->
-            receive after 50 -> ok end,
-            portnr(LRef, N-1)
-    end.
-
-realm(Host) ->
-    tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
-
-make_cert(Dir, Keyfile, Certfile) ->
-    [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]],
-
-    KCmd = join(["openssl genrsa -out", K, "2048"]),
-    CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7",
-                 "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]),
-
-    %% Hope for the best and only check that files are written.
-    os:cmd(KCmd),
-    os:cmd(CCmd),
-
-    [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]],
-
-    {K,C}.
-
-join(Strs) ->
-    string:join(Strs, " ").
+     send3,
+     send4,
+     send5].
 
 %% ===========================================================================
+%% testcases
 
 %% Send an STR intended for a specific server and expect success.
 send1(_Config) ->
@@ -246,46 +183,22 @@ send2(_Config) ->
     call(?SERVER2).
 send3(_Config) ->
     call(?SERVER3).
+send4(_Config) ->
+    call(?SERVER4).
+send5(_Config) ->
+    call(?SERVER5).
 
 %% Remove the client transports and expect the corresponding server
 %% transport to go down.
 remove_transports(Config) ->
     Ts = proplists:get_value(transports, Config),
-
-    true = diameter:subscribe(?SERVER1),
-    true = diameter:subscribe(?SERVER2),
-    true = diameter:subscribe(?SERVER3),
-
+    [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true],
     lists:map(fun disconnect/1, Ts).
 
-disconnect({{LRef, _PortNr}, CRef}) ->
-    ok = diameter:remove_transport(?CLIENT, CRef),
-    ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
-         after 2000 -> false
-         end.
-
 stop_services(_Config) ->
-    S = [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3],
-    Ok = [ok || _ <- S],
-    Ok = [diameter:stop_service(H) || H <- S].
-
-%% ===========================================================================
-
-call(Server) ->
-    Realm = realm(Server),
-    Req = ['STR', {'Destination-Realm', Realm},
-                  {'Termination-Cause', ?LOGOUT},
-                  {'Auth-Application-Id', ?APP_ID}],
-    #diameter_base_STA{'Result-Code' = ?SUCCESS,
-                       'Origin-Host' = Server,
-                       'Origin-Realm' = Realm}
-        = call(Req, [{filter, realm}]).
-
-call(Req, Opts) ->
-    diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
-    
-set([H|T], Vs) ->
-    [H | Vs ++ T].
+    Hs = [?CLIENT | ?SERVERS],
+    Ok = [ok || _ <- Hs],
+    Ok = [diameter:stop_service(H) || H <- Hs].
 
 %% ===========================================================================
 %% diameter callbacks
@@ -345,3 +258,128 @@ handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},
                                'Session-Id' = SId,
                                'Origin-Host' = OH,
                                'Origin-Realm' = OR}}.
+
+%% ===========================================================================
+%% support functions
+
+call(Server) ->
+    Realm = realm(Server),
+    Req = ['STR', {'Destination-Realm', Realm},
+                  {'Termination-Cause', ?LOGOUT},
+                  {'Auth-Application-Id', ?APP_ID}],
+    #diameter_base_STA{'Result-Code' = ?SUCCESS,
+                       'Origin-Host' = Server,
+                       'Origin-Realm' = Realm}
+        = call(Req, [{filter, realm}]).
+
+call(Req, Opts) ->
+    diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
+
+set([H|T], Vs) ->
+    [H | Vs ++ T].
+
+disconnect({{LRef, _PortNr}, CRef}) ->
+    ok = diameter:remove_transport(?CLIENT, CRef),
+    ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
+         after 2000 -> false
+         end.
+
+realm(Host) ->
+    tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
+inband_security(Ids) ->
+    [{'Inband-Security-Id', Ids}].
+
+ssl_options(Dir, Base) ->
+    {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"),
+    [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}].
+
+make_cert(Dir, Keyfile, Certfile) ->
+    [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]],
+
+    KCmd = join(["openssl genrsa -out", K, "2048"]),
+    CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7",
+                 "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]),
+
+    %% Hope for the best and only check that files are written.
+    os:cmd(KCmd),
+    os:cmd(CCmd),
+
+    [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]],
+
+    {K,C}.
+
+join(Strs) ->
+    string:join(Strs, " ").
+
+%% server/2
+
+server(Host, {Caps, Opts}) ->
+    ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)),
+    {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)),
+    {LRef, portnr(LRef)}.
+
+sopts(?SERVER1, Dir) ->
+    {inband_security([?TLS]),
+     ssl_options(Dir, "server1")};
+sopts(?SERVER2, Dir) ->
+    {inband_security([?NO_INBAND_SECURITY, ?TLS]),
+     ssl_options(Dir, "server2")};
+sopts(?SERVER3, _) ->
+    {[], []};
+sopts(?SERVER4, Dir) ->
+    {[], ssl(ssl_options(Dir, "server4"))};
+sopts(?SERVER5, Dir) ->
+    {[], ssl(ssl_options(Dir, "server5"))}.
+
+ssl([{ssl_options = T, Opts}]) ->
+    [{T, true} | Opts].
+
+portnr(LRef) ->
+    portnr(LRef, 20).
+
+portnr(LRef, N)
+  when 0 < N ->
+    case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
+        [{T, _Pid}] ->
+            {_, _, {LRef, {_Addr, LSock}}} = T,
+            {ok, PortNr} = to_portnr(LSock) ,
+            PortNr;
+        [] ->
+            receive after 500 -> ok end,
+            portnr(LRef, N-1)
+    end.
+
+to_portnr(Sock)
+  when is_port(Sock) ->
+    inet:port(Sock);
+to_portnr(Sock) ->
+    case ssl:sockname(Sock) of
+        {ok, {_,N}} ->
+            {ok, N};
+        No ->
+            No
+    end.
+
+%% connect/3
+
+connect(Host, {_LRef, PortNr}, {Caps, Opts}) ->
+    {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)),
+    ok = receive
+             #diameter_event{service = Host,
+                             info = {up, Ref, _, _, #diameter_packet{}}} ->
+                 ok
+         after 2000 ->
+                 false
+         end,
+    Ref.
+
+copts(S, Opts)
+  when S == ?SERVER1;
+       S == ?SERVER2;
+       S == ?SERVER3 ->
+    {inband_security([?NO_INBAND_SECURITY, ?TLS]), Opts};
+copts(S, Opts)
+  when S == ?SERVER4;
+       S == ?SERVER5 ->
+    {[], ssl(Opts)}.