aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2011-10-10 11:13:58 +0200
committerAnders Svensson <[email protected]>2011-10-10 11:13:58 +0200
commiteb9656c94f4e92c2a4875dc628cb41d283dd4d2b (patch)
tree998adcdcf2386125e34c5d7bd389f43772f31c7b /lib
parentcf1de23f71d22c1b9d9502882136b320a087d7e3 (diff)
parent942e68d3f93ce686a16d27716892e7c0d2e5872b (diff)
downloadotp-eb9656c94f4e92c2a4875dc628cb41d283dd4d2b.tar.gz
otp-eb9656c94f4e92c2a4875dc628cb41d283dd4d2b.tar.bz2
otp-eb9656c94f4e92c2a4875dc628cb41d283dd4d2b.zip
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
Diffstat (limited to 'lib')
-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