aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/diameter/doc/src/diameter.xml21
-rw-r--r--lib/diameter/doc/src/diameter_soc.xml10
-rw-r--r--lib/diameter/doc/src/diameter_tcp.xml50
-rw-r--r--lib/diameter/doc/src/diameter_transport.xml38
-rw-r--r--lib/diameter/src/app/diameter_capx.erl145
-rw-r--r--lib/diameter/src/app/diameter_peer_fsm.erl87
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl8
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl209
-rw-r--r--lib/diameter/test/diameter_app_SUITE.erl18
-rw-r--r--lib/diameter/test/diameter_tls_SUITE.erl419
-rw-r--r--lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca43
-rw-r--r--lib/diameter/test/modules.mk3
12 files changed, 899 insertions, 152 deletions
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 2cad70e3bc..43c497f50a 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -367,6 +367,19 @@ capabilities exchange message.
Optional, defaults to the empty list.</p>
</item>
+<tag><c>{'Inband-Security-Id', [Unsigned32()]}</c></tag>
+<item>
+<p>
+Values of Inband-Security-Id AVPs sent in an outgoing
+capabilities exchange message.
+Optional, defaults to the empty list, which is equivalent to a
+list containing only 0 (= NO_INBAND_SECURITY).</p>
+
+<p>
+If 1 (= TLS) is specified then TLS is selected if the CER/CEA received
+from the peer offers it.</p>
+</item>
+
<tag><c>{'Acct-Application-Id', [Unsigned32()]}</c></tag>
<item>
<p>
@@ -683,6 +696,14 @@ in question.</p>
AVP's used to construct outgoing CER/CEA messages.
Any AVP specified takes precedence over a corresponding value specified
for the service in question.</p>
+
+<p>
+Specifying a capability as a transport option
+may be particularly appropriate for Inband-Security-Id in case
+TLS is desired over TCP as implemented by
+<seealso marker="diameter_tcp">diameter_tcp(3)</seealso> but
+not over SCTP as implemented by
+<seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p>
</item>
<tag><c>{watchdog_timer, TwInit}</c></tag>
diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml
index 4f8581a904..6b9ef9f756 100644
--- a/lib/diameter/doc/src/diameter_soc.xml
+++ b/lib/diameter/doc/src/diameter_soc.xml
@@ -57,9 +57,13 @@ including the P Flag in the AVP header.</p>
<item>
<p>
-There is no TLS support.
-It's unclear (aka uninvestigated) how TLS would impact
-diameter but IPsec can be used without it needing to know.</p>
+There is no TLS support over SCTP.
+RFC 3588 requires that a Diameter server support TLS but in
+practise this seems to mean TLS over SCTP since there are limitations
+with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a
+response to RFC 3436 (TLS over SCTP).
+The current RFC 3588 draft acknowledges this by equating
+TLS with TLS/TCP and DTLS/SCTP but we do not yet support DTLS.</p>
</item>
<item>
diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml
index a502e53972..e6b53383c0 100644
--- a/lib/diameter/doc/src/diameter_tcp.xml
+++ b/lib/diameter/doc/src/diameter_tcp.xml
@@ -43,7 +43,14 @@ It can be specified as the value of a transport_module option to
<seealso
marker="diameter#add_transport">diameter:add_transport/2</seealso>
and implements the behaviour documented in
-<seealso marker="diameter_transport">diameter_transport(3)</seealso>.</p>
+<seealso marker="diameter_transport">diameter_transport(3)</seealso>.
+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>
+
+<p>
+Note that the ssl application is required for TLS and must be started
+before configuring TLS capability on diameter transports.</p>
<marker id="start"/>
</description>
@@ -60,10 +67,15 @@ and implements the behaviour documented in
<v>Type = connect | accept</v>
<v>Ref = reference()</v>
<v>Svc = #diameter_service{}</v>
-<v>Opt = {raddr, ip_address()} | {rport, integer()} | term()</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()}
+ | {port, integer()}</v>
+<v>SslOpt = {ssl_options, true | list()}</v>
+<v>OtherOpt = term()</v>
</type>
<desc>
@@ -74,17 +86,42 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</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 not valid for a listening
+and port for a connecting transport and are not valid for a listening
transport.
-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>
+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
+marker="diameter#start_service">start_service/2</seealso> or
+<seealso
+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 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
+that will not be forthcoming, which will eventually cause the RFC 3539
+watchdog to take down the connection.</p>
+
+<p>
If the service specifies more than one Host-IP-Address and
option <c>ip</c> is unspecified then then the
first of the service's addresses is used as the local address.</p>
@@ -104,6 +141,7 @@ The returned local address list has length one.</p>
<title>SEE ALSO</title>
<p>
+<seealso marker="diameter">diameter(3)</seealso>,
<seealso marker="diameter_transport">diameter_transport(3)</seealso></p>
</section>
diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml
index 37cc871e75..087a90b099 100644
--- a/lib/diameter/doc/src/diameter_transport.xml
+++ b/lib/diameter/doc/src/diameter_transport.xml
@@ -143,6 +143,34 @@ connection.
Pid is the pid() of the parent process.</p>
</item>
+<tag><c>{diameter, {tls, Ref, Type, Bool}}</c></tag>
+<item>
+<p>
+Indication of whether or not capabilities exchange has selected
+inband security using TLS.
+Ref is a reference() that must be included in the
+<c>{diameter, {tls, Ref}}</c> reply message to the transport's
+parent process (see below).
+Type is either <c>connect</c> or <c>accept</c> depending on
+whether the process has been started for a connecting or listening
+transport respectively.
+Bool is a boolean() indicating whether or not the transport connection
+should be upgraded to TLS.</p>
+
+<p>
+If TLS is requested (Bool = true) then a connecting process should
+initiate a TLS handshake with the peer and an accepting process should
+prepare to accept a handshake.
+A successful handshake should be followed by a <c>{diameter, {tls, Ref}}</c>
+message to the parent process.
+A failed handshake should cause the process to exit.</p>
+
+<p>
+This message is only sent to a transport process over whose
+<c>Inband-Security-Id</c> configuration has indicated support for
+TLS.</p>
+</item>
+
</taglist>
<p>
@@ -184,6 +212,16 @@ How the <c>transport_data</c> is used/interpreted is up to the
transport module.</p>
</item>
+<tag><c>{diameter, {tls, Ref}}</c></tag>
+<item>
+<p>
+Acknowledgment of a successful TLS handshake.
+Ref is the reference() received in the
+<c>{diameter, {tls, Ref, Type, Bool}}</c> message in response
+to which the reply is sent.
+A transport must exit if a handshake is not successful.</p>
+</item>
+
</taglist>
</section>
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).
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
index 104785b4e6..15a98d4441 100644
--- a/lib/diameter/test/diameter_app_SUITE.erl
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -147,14 +147,13 @@ appvsn(Name) ->
%% ===========================================================================
%% # xref/1
%%
-%% Ensure that no function in our application calls an undefined function.
+%% Ensure that no function in our application calls an undefined function
+%% or one in an application we haven't specified as a dependency. (Almost.)
%% ===========================================================================
xref(Config) ->
App = fetch(app, Config),
- Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg],
- %% Skip modules that aren't required at runtime and that have
- %% dependencies beyond those applications listed in the app file.
+ Mods = fetch(modules, App),
{ok, XRef} = xref:start(make_name(xref_test_name)),
ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]),
@@ -164,7 +163,10 @@ xref(Config) ->
%% stop xref from complaining about calls to module erlang, which
%% was previously in kernel. Erts isn't an application however, in
%% the sense that there's no .app file, and isn't listed in
- %% applications. Seems less than ideal.
+ %% applications. Seems less than ideal. Also, diameter_tcp does
+ %% call ssl despite ssl not being listed as a dependency in the
+ %% app file since ssl is only required for TLS security: it's up
+ %% to a client who wants TLS it to start ssl.
ok = lists:foreach(fun(A) -> add_application(XRef, A) end,
[?APP, erts | fetch(applications, App)]),
@@ -173,7 +175,11 @@ xref(Config) ->
xref:stop(XRef),
%% Only care about calls from our own application.
- [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs).
+ [] = lists:filter(fun({{F,_,_},{T,_,_}}) ->
+ lists:member(F, Mods)
+ andalso {F,T} /= {diameter_tcp, ssl}
+ end,
+ Undefs).
add_application(XRef, App) ->
add_application(XRef, App, code:lib_dir(App)).
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
new file mode 100644
index 0000000000..90e32c834f
--- /dev/null
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -0,0 +1,419 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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 traffic between six Diameter nodes connected as follows.
+%%
+%% ---- SERVER.REALM1 (TLS after capabilities exchange)
+%% /
+%% / ---- SERVER.REALM2 (ditto)
+%% | /
+%% CLIENT.REALM0 ----- SERVER.REALM3 (no security)
+%% | \
+%% \ ---- SERVER.REALM4 (TLS at connection establishment)
+%% \
+%% ---- SERVER.REALM5 (ditto)
+%%
+
+-module(diameter_tls_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([start_ssl/1,
+ start_diameter/1,
+ start_services/1,
+ add_transports/1,
+ send1/1,
+ send2/1,
+ send3/1,
+ send4/1,
+ send5/1,
+ remove_transports/1,
+ stop_services/1,
+ stop_diameter/1,
+ stop_ssl/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT.REALM0").
+-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).
+
+-define(APP_ALIAS, the_app).
+-define(APP_ID, ?DICT_COMMON:id()).
+
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host, Dict),
+ [{'Origin-Host', Host},
+ {'Origin-Realm', realm(Host)},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Inband-Security-Id', [?NO_INBAND_SECURITY]},
+ {'Auth-Application-Id', [Dict:id()]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, Dict},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+%% Config for diameter:add_transport/2. In the listening case, listen
+%% on a free port that we then lookup using the implementation detail
+%% that diameter_tcp registers the port with diameter_reg.
+-define(CONNECT(PortNr, Caps, Opts),
+ {connect, [{transport_module, diameter_tcp},
+ {transport_config, [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}
+ | Opts]},
+ {capabilities, Caps}]}).
+-define(LISTEN(Caps, Opts),
+ {listen, [{transport_module, diameter_tcp},
+ {transport_config, [{ip, ?ADDR}, {port, 0} | Opts]},
+ {capabilities, Caps}]}).
+
+-define(SUCCESS, 2001).
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 15}}].
+
+all() ->
+ [start_ssl,
+ start_diameter,
+ start_services,
+ add_transports]
+ ++ [{group, N} || {N, _, _} <- groups()]
+ ++ [remove_transports, stop_services, stop_diameter, stop_ssl].
+
+groups() ->
+ Ts = tc(),
+ [{all, [], Ts},
+ {p, [parallel], Ts}].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ case os:find_executable("openssl") of
+ false ->
+ {skip, no_openssl};
+ _ ->
+ Config
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+%% Testcases to run when services are started and connections
+%% established.
+tc() ->
+ [send1,
+ send2,
+ send3,
+ send4,
+ send5].
+
+%% ===========================================================================
+%% testcases
+
+start_ssl(_Config) ->
+ ok = ssl:start().
+
+start_diameter(_Config) ->
+ ok = diameter:start().
+
+start_services(Config) ->
+ Dir = proplists:get_value(priv_dir, Config),
+ Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ {save_config, [Dir | Servers]}.
+
+add_transports(Config) ->
+ {_, [Dir | Servers]} = proplists:get_value(saved_config, Config),
+
+ true = diameter:subscribe(?CLIENT),
+
+ Opts = ssl_options(Dir, "client"),
+ Connections = [connect(?CLIENT, S, copts(N, Opts))
+ || {S,N} <- lists:zip(Servers, ?SERVERS)],
+
+ ?util:write_priv(Config, "cfg", lists:zip(Servers, Connections)).
+
+
+%% Remove the client transports and expect the corresponding server
+%% transport to go down.
+remove_transports(Config) ->
+ Ts = ?util:read_priv(Config, "cfg"),
+ [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true],
+ lists:map(fun disconnect/1, Ts).
+
+stop_services(_Config) ->
+ [] = [{H,T} || H <- [?CLIENT | ?SERVERS],
+ T <- [diameter:stop_service(H)],
+ T /= ok].
+
+stop_diameter(_Config) ->
+ ok = diameter:stop().
+
+stop_ssl(_Config) ->
+ ok = ssl:stop().
+
+%% Send an STR intended for a specific server and expect success.
+send1(_Config) ->
+ call(?SERVER1).
+send2(_Config) ->
+ call(?SERVER2).
+send3(_Config) ->
+ call(?SERVER3).
+send4(_Config) ->
+ call(?SERVER4).
+send5(_Config) ->
+ call(?SERVER5).
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+pick_peer([Peer], _, ?CLIENT, _State) ->
+ {ok, Peer}.
+
+%% prepare_request/3
+
+prepare_request(#diameter_packet{msg = Req},
+ ?CLIENT,
+ {_Ref, Caps}) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+
+ {send, set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR}])}.
+
+%% prepare_retransmit/3
+
+prepare_retransmit(_Pkt, false, _Peer) ->
+ discard.
+
+%% handle_answer/4
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, ?CLIENT, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},
+ OH,
+ {_Ref, #diameter_caps{origin_host = {OH,_},
+ origin_realm = {OR, _}}})
+ when OH /= ?CLIENT ->
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ '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)}.
diff --git a/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca
new file mode 100644
index 0000000000..3f2645add0
--- /dev/null
+++ b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca
@@ -0,0 +1,43 @@
+# -*- makefile -*-
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2011. 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%
+
+#
+# Certificates are now generated from the suite itself but the
+# makefile itself is still useful.
+#
+
+KEYS = $(HOSTS:%=%_key.pem)
+CERTS = $(HOSTS:%=%_ca.pem)
+
+all: $(CERTS)
+
+%_ca.pem: %_key.pem
+ openssl req -new -x509 -key $< -out $@ -days 1095 \
+ -subj '/C=SE/ST=./L=Stockholm/CN=www.erlang.org'
+
+%_key.pem:
+ openssl genrsa -out $@ 2048
+
+clean:
+ rm -f $(CERTS)
+
+realclean: clean
+ rm -f $(KEYS)
+
+.PRECIOUS: $(KEYS)
+.PHONY: all clean realclean
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index c6f709dc36..7c691c302b 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -34,7 +34,8 @@ MODULES = \
diameter_watchdog_SUITE \
diameter_transport_SUITE \
diameter_traffic_SUITE \
- diameter_relay_SUITE
+ diameter_relay_SUITE \
+ diameter_tls_SUITE
INTERNAL_HRL_FILES = \
diameter_ct.hrl