diff options
Diffstat (limited to 'lib/diameter/src/transport/diameter_tcp.erl')
| -rw-r--r-- | lib/diameter/src/transport/diameter_tcp.erl | 209 |
1 files changed, 165 insertions, 44 deletions
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). |