aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/transport/diameter_tcp.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/src/transport/diameter_tcp.erl')
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl284
1 files changed, 230 insertions, 54 deletions
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 653c114471..78dbda6888 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -37,6 +37,9 @@
code_change/3,
terminate/2]).
+-export([ports/0,
+ ports/1]).
+
-include_lib("diameter/include/diameter.hrl").
-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
@@ -45,6 +48,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 +77,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 +128,18 @@ 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),
+ putr(ref, Ref),
#transport{parent = Pid,
- module = Mod,
- socket = Sock};
+ module = M,
+ socket = Sock,
+ ssl = SslOpts};
+%% Put the reference in the process dictionary since we now use it
+%% advertise the ssl socket after TLS upgrade.
%% A monitor process to kill the transport if the parent dies.
i(#monitor{parent = Pid, transport = TPid} = S) ->
@@ -146,27 +158,51 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
LAddr = get_addr(LA, Addrs),
LPort = get_port(LP),
{ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)),
+ true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
proc_lib:init_ack({ok, self(), {LAddr, LSock}}),
erlang:monitor(process, APid),
- 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) ->
+i(accept = T, Ref, Mod, Pid, Opts, Addrs) ->
{LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(accept(Mod, LSock)),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid),
Sock;
-i(connect, _, Mod, Pid, Opts, Addrs) ->
+i(connect = T, Ref, Mod, Pid, Opts, Addrs) ->
{[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]),
LAddr = get_addr(LA, Addrs),
RAddr = get_addr(RA, []),
RPort = get_port(RP),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid, {RAddr, RPort}),
Sock.
@@ -227,6 +263,43 @@ gen_opts(LAddr, Opts) ->
| Opts].
%% ---------------------------------------------------------------------------
+%% # ports/1
+%% ---------------------------------------------------------------------------
+
+ports() ->
+ Ts = diameter_reg:match({?MODULE, '_', '_'}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts].
+
+ports(Ref) ->
+ Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts,
+ R == Ref].
+
+type(listener) ->
+ listen;
+type(T) ->
+ T.
+
+sock(listener, {_LAddr, Sock}) ->
+ Sock;
+sock(_, Sock) ->
+ Sock.
+
+resolve(Type, S) ->
+ Sock = sock(Type, S),
+ try
+ ok(portnr(Sock))
+ catch
+ _:_ -> Sock
+ end.
+
+portnr(Sock)
+ when is_port(Sock) ->
+ portnr(gen_tcp, Sock);
+portnr(Sock) ->
+ portnr(ssl, Sock).
+
+%% ---------------------------------------------------------------------------
%% # handle_call/3
%% ---------------------------------------------------------------------------
@@ -258,6 +331,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}.
@@ -270,6 +345,12 @@ terminate(_, _) ->
%% ---------------------------------------------------------------------------
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
%% start_timer/1
start_timer(#listener{count = 0} = S) ->
@@ -332,17 +413,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(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),
- recv(Data, S);
+ 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.
@@ -367,10 +487,10 @@ transition({timeout, TRef, flush}, S) ->
flush(TRef, S);
%% Request for the local port number.
-transition({resolve_port, RPid}, #transport{socket = Sock,
- module = M})
- when is_pid(RPid) ->
- RPid ! lport(M, Sock),
+transition({resolve_port, Pid}, #transport{socket = Sock,
+ module = M})
+ when is_pid(Pid) ->
+ Pid ! portnr(M, Sock),
ok;
%% Parent process has died.
@@ -379,80 +499,122 @@ 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]),
+ Ref = getr(ref),
+ is_reference(Ref) %% started in new code
+ andalso
+ (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})),
+ 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 +651,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 +670,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 +679,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).
@@ -523,9 +692,16 @@ setopts(M, Sock) ->
X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect
end.
-%% lport/2
+%% portnr/2
-lport(gen_tcp, Sock) ->
+portnr(gen_tcp, Sock) ->
inet:port(Sock);
-lport(M, Sock) ->
+portnr(ssl, Sock) ->
+ case ssl:sockname(Sock) of
+ {ok, {_Addr, PortNr}} ->
+ {ok, PortNr};
+ {error, _} = No ->
+ No
+ end;
+portnr(M, Sock) ->
M:port(Sock).