diff options
Diffstat (limited to 'lib/ssl/src')
30 files changed, 1269 insertions, 4160 deletions
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 7514ad2aa2..dc69b53b28 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -41,12 +41,9 @@ MODULES= \ ssl \ ssl_alert \ ssl_app \ - ssl_broker \ - ssl_broker_sup \ - ssl_server \ + ssl_dist_sup\ ssl_sup \ - ssl_prim \ - inet_ssl_dist \ + inet_tls_dist \ ssl_certificate\ ssl_certificate_db\ ssl_cipher \ @@ -62,9 +59,10 @@ MODULES= \ ssl_ssl2 \ ssl_ssl3 \ ssl_tls1 \ + ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \ + ssl_debug.hrl \ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ ssl_record.hrl diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl deleted file mode 100644 index 6c0fbc0618..0000000000 --- a/lib/ssl/src/inet_ssl_dist.erl +++ /dev/null @@ -1,456 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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% -%% - -%% --module(inet_ssl_dist). - -%% Handles the connection setup phase with other Erlang nodes. - --export([childspecs/0, listen/1, accept/1, accept_connection/5, - setup/5, close/1, select/1, is_node_name/1]). - -%% internal exports - --export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]). - --import(error_logger,[error_msg/2]). - --include("net_address.hrl"). - - - --define(to_port(Socket, Data, Opts), - case ssl_prim:send(Socket, Data, Opts) of - {error, closed} -> - self() ! {ssl_closed, Socket}, - {error, closed}; - R -> - R - end). - - --include("dist.hrl"). --include("dist_util.hrl"). - -%% ------------------------------------------------------------- -%% This function should return a valid childspec, so that -%% the primitive ssl_server gets supervised -%% ------------------------------------------------------------- -childspecs() -> - {ok, [{ssl_server_prim,{ssl_server, start_link_prim, []}, - permanent, 2000, worker, [ssl_server]}]}. - - -%% ------------------------------------------------------------ -%% Select this protocol based on node name -%% select(Node) => Bool -%% ------------------------------------------------------------ - -select(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_,_Host] -> true; - _ -> false - end. - -%% ------------------------------------------------------------ -%% Create the listen socket, i.e. the port that this erlang -%% node is accessible through. -%% ------------------------------------------------------------ - -listen(Name) -> - case ssl_prim:listen(0, [{active, false}, {packet,4}] ++ - get_ssl_options(server)) of - {ok, Socket} -> - TcpAddress = get_tcp_address(Socket), - {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; - Error -> - Error - end. - -%% ------------------------------------------------------------ -%% Accepts new connection attempts from other Erlang nodes. -%% ------------------------------------------------------------ - -accept(Listen) -> - spawn_link(?MODULE, accept_loop, [self(), Listen]). - -accept_loop(Kernel, Listen) -> - process_flag(priority, max), - case ssl_prim:accept(Listen) of - {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,ssl}, - controller(Kernel, Socket), - accept_loop(Kernel, Listen); - Error -> - exit(Error) - end. - -controller(Kernel, Socket) -> - receive - {Kernel, controller, Pid} -> - flush_controller(Pid, Socket), - ssl_prim:controlling_process(Socket, Pid), - flush_controller(Pid, Socket), - Pid ! {self(), controller}; - {Kernel, unsupported_protocol} -> - exit(unsupported_protocol) - end. - -flush_controller(Pid, Socket) -> - receive - {ssl, Socket, Data} -> - Pid ! {ssl, Socket, Data}, - flush_controller(Pid, Socket); - {ssl_closed, Socket} -> - Pid ! {ssl_closed, Socket}, - flush_controller(Pid, Socket) - after 0 -> - ok - end. - -%% ------------------------------------------------------------ -%% Accepts a new connection attempt from another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - spawn_link(?MODULE, do_accept, - [self(), AcceptPid, Socket, MyNode, - Allowed, SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_accept(_,_,_,_,_,_) -> no_return()). -do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - process_flag(priority, max), - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Socket) of - true -> - HSData = #hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - allowed = Allowed, - f_send = fun(S,D) -> ssl_prim:send(S,D) end, - f_recv = fun(S,N,T) -> ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{deliver, port}, - {active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = fun get_remote_id/2, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1 - }, - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end - end. - -%% ------------------------------------------------------------ -%% Get remote information about a Socket. -%% ------------------------------------------------------------ - -get_remote_id(Socket, Node) -> - {ok, Address} = ssl_prim:peername(Socket), - [_, Host] = split_node(atom_to_list(Node), $@, []), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet }. - -%% ------------------------------------------------------------ -%% Setup a new connection to another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - spawn_link(?MODULE, do_setup, [self(), - Node, - Type, - MyNode, - LongOrShortNames, - SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_setup(_,_,_,_,_,_) -> no_return()). -do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> - process_flag(priority, max), - ?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]), - [Name, Address] = splitnode(Node, LongOrShortNames), - case inet:getaddr(Address, inet) of - {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), - case erl_epmd:port_please(Name, Ip) of - {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), - dist_util:reset_timer(Timer), - case ssl_prim:connect(Ip, TcpPort, - [{active, false}, - {packet,4}] ++ - get_ssl_options(client)) of - {ok, Socket} -> - HSData = #hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - other_version = Version, - f_send = fun(S,D) -> - ssl_prim:send(S,D) - end, - f_recv = fun(S,N,T) -> - ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{deliver, port},{active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = - fun(_,_) -> - #net_address { - address = {Ip,TcpPort}, - host = Address, - protocol = ssl, - family = inet} - end, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown(Node) - end; - _ -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown(Node) - end; - _Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,Other]), - ?shutdown(Node) - end. - -%% -%% Close a socket. -%% -close(Socket) -> - ssl_prim:close(Socket). - - -%% If Node is illegal terminate the connection setup!! -splitnode(Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), - case split_node(Host, $., []) of - [_] when LongOrShortNames == longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - [_, _ | _] when LongOrShortNames == shortnames -> - error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - _ -> - [Name, Host] - end; - [_] -> - error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); - _ -> - error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) - end. - -split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> [lists:reverse(Ack)]. - -%% ------------------------------------------------------------ -%% Fetch local information about a Socket. -%% ------------------------------------------------------------ -get_tcp_address(Socket) -> - {ok, Address} = ssl_prim:sockname(Socket), - {ok, Host} = inet:gethostname(), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet - }. - -%% ------------------------------------------------------------ -%% Do only accept new connection attempts from nodes at our -%% own LAN, if the check_ip environment parameter is true. -%% ------------------------------------------------------------ -check_ip(Socket) -> - case application:get_env(check_ip) of - {ok, true} -> - case get_ifs(Socket) of - {ok, IFs, IP} -> - check_ip(IFs, IP); - _ -> - ?shutdown(no_node) - end; - _ -> - true - end. - -get_ifs(Socket) -> - case ssl_prim:peername(Socket) of - {ok, {IP, _}} -> - case ssl_prim:getif(Socket) of - {ok, IFs} -> {ok, IFs, IP}; - Error -> Error - end; - Error -> - Error - end. - -check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) - end; -check_ip([], PeerIP) -> - {false, PeerIP}. - -mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> - {M1 band IP1, - M2 band IP2, - M3 band IP3, - M4 band IP4}. - -is_node_name(Node) when is_atom(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, _Host] -> true; - _ -> false - end; -is_node_name(_Node) -> - false. -tick(Sock) -> - ?to_port(Sock,[],[force]). -getstat(Socket) -> - case ssl_prim:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of - {ok, Stat} -> - split_stat(Stat,0,0,0); - Error -> - Error - end. - -split_stat([{recv_cnt, R}|Stat], _, W, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_cnt, W}|Stat], R, _, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_pend, P}|Stat], R, W, _) -> - split_stat(Stat, R, W, P); -split_stat([], R, W, P) -> - {ok, R, W, P}. - - -get_ssl_options(Type) -> - case init:get_argument(ssl_dist_opt) of - {ok, Args} -> - ssl_options(Type, Args); - _ -> - [] - end. - -ssl_options(_,[]) -> - []; -ssl_options(server, [["server_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_cacertfile", Value]|T]) -> - [{cacertfile, Value} | ssl_options(server,T)]; -ssl_options(server, [["server_keyfile", Value]|T]) -> - [{keyfile, Value} | ssl_options(server,T)]; -ssl_options(Type, [["client_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [["server_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [[Item, Value]|T]) -> - [{atomize(Item),fixup(Value)} | ssl_options(Type,T)]; -ssl_options(Type, [[Item,Value |T1]|T2]) -> - ssl_options(atomize(Type),[[Item,Value],T1|T2]); -ssl_options(_,_) -> - exit(malformed_ssl_dist_opt). - -fixup(Value) -> - case catch list_to_integer(Value) of - {'EXIT',_} -> - Value; - Int -> - Int - end. - -atomize(List) when is_list(List) -> - list_to_atom(List); -atomize(Atom) when is_atom(Atom) -> - Atom. diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl new file mode 100644 index 0000000000..bc395cb6d5 --- /dev/null +++ b/lib/ssl/src/inet_tls_dist.erl @@ -0,0 +1,281 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% + +%% +-module(inet_tls_dist). + +-export([childspecs/0, listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +-include_lib("kernel/include/net_address.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). + +childspecs() -> + {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, + permanent, 2000, worker, [ssl_dist_sup]}]}. + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_,_Host] -> + true; + _ -> + false + end. + +is_node_name(Node) when is_atom(Node) -> + select(Node); +is_node_name(_) -> + false. + +listen(Name) -> + ssl_tls_dist_proxy:listen(Name). + +accept(Listen) -> + ssl_tls_dist_proxy:accept(Listen). + +accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + Kernel = self(), + spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket, + MyNode, Allowed, SetupTime) end). + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + Kernel = self(), + spawn_opt(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end, [link, {priority, max}]). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + case erl_epmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case ssl_tls_dist_proxy:connect(Ip, TcpPort) of + {ok, Socket} -> + HSData = connect_hs_data(Kernel, Node, MyNode, Socket, + Timer, Version, Ip, TcpPort, Address, + Type), + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,Other]), + ?shutdown(Node) + end. + +close(Socket) -> + try + erlang:error(foo) + catch _:_ -> + io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) + end, + gen_tcp:close(Socket), + ok. + +do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + process_flag(priority, max), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(Socket) of + true -> + HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_logger:error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(Socket) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(Socket) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(Socket) -> + case inet:peername(Socket) of + {ok, {IP, _}} -> + case inet:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4}; + +mask({M1,M2,M3,M4, M5, M6, M7, M8}, {IP1,IP2,IP3,IP4, IP5, IP6, IP7, IP8}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4, + M5 band IP5, + M6 band IP6, + M7 band IP7, + M8 band IP8}. + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + check_node(Name, Node, Host, LongOrShortNames); + [_] -> + error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +check_node(Name, Node, Host, LongOrShortNames) -> + case split_node(Host, $., []) of + [_] when LongOrShortNames == longnames -> + error_logger:error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + [_, _ | _] when LongOrShortNames == shortnames -> + error_logger:error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end. + +split_node([Chr|T], Chr, Ack) -> + [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> + split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> + [lists:reverse(Ack)]. + +connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> + common_hs_data(Kernel, MyNode, Socket, Timer, + #hs_data{other_node = Node, + other_version = Version, + f_address = + fun(_,_) -> + #net_address{address = {Ip,TcpPort}, + host = Address, + protocol = proxy, + family = inet} + end, + request_type = Type + }). + +accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> + common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ + allowed = Allowed, + f_address = fun get_remote_id/2 + }). + +common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> + HsData#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = Socket, + timer = Timer, + this_flags = 0, + f_send = + fun(S,D) -> + gen_tcp:send(S,D) + end, + f_recv = + fun(S,N,T) -> + gen_tcp:recv(S,N,T) + end, + f_setopts_pre_nodeup = + fun(S) -> + inet:setopts(S, [{active, false}, {packet, 4}]) + end, + f_setopts_post_nodeup = + fun(S) -> + inet:setopts(S, [{deliver, port},{active, true}]) + end, + f_getll = + fun(S) -> + inet:getll(S) + end, + mf_tick = + fun(S) -> + gen_tcp:send(S, <<>>) + end, + mf_getstat = + fun(S) -> + {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), + R = proplists:get_value(recv_cnt, Stats, 0), + W = proplists:get_value(send_cnt, Stats, 0), + P = proplists:get_value(send_pend, Stats, 0), + {ok, R,W,P} + end}. + +get_remote_id(Socket, _Node) -> + case ssl_tls_dist_proxy:get_tcp_address(Socket) of + {ok, Address} -> + Address; + {error, _Reason} -> + ?shutdown(no_node) + end. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index b9716786e6..13d5eaf4d7 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -4,11 +4,9 @@ {modules, [ssl, ssl_app, ssl_sup, - ssl_server, - ssl_broker, - ssl_broker_sup, - ssl_prim, - inet_ssl_dist, + inet_tls_dist, + ssl_tls_dist_proxy, + ssl_dist_sup, ssl_tls1, ssl_ssl3, ssl_ssl2, @@ -26,7 +24,7 @@ ssl_certificate, ssl_alert ]}, - {registered, [ssl_sup, ssl_server, ssl_broker_sup]}, + {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}]}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 29674f30da..1b07e76d6a 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.6", [{restart_application, ssl}]}, {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, @@ -10,6 +11,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.6", [{restart_application, ssl}]}, {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 59f8479a4c..d0693445e0 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -25,18 +25,15 @@ -export([start/0, start/1, stop/0, transport_accept/1, transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3, - ciphers/0, cipher_suites/0, cipher_suites/1, close/1, shutdown/2, + cipher_suites/0, cipher_suites/1, close/1, shutdown/2, connect/3, connect/2, connect/4, connection_info/1, - controlling_process/2, listen/2, pid/1, peername/1, recv/2, recv/3, - send/2, getopts/2, setopts/2, seed/1, sockname/1, peercert/1, - peercert/2, version/0, versions/0, session_info/1, format_error/1, + controlling_process/2, listen/2, pid/1, peername/1, peercert/1, + recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, + versions/0, session_info/1, format_error/1, renegotiate/1]). -%% Should be deprecated as soon as old ssl is removed -%%-deprecated({pid, 1, next_major_release}). --deprecated({peercert, 2, next_major_release}). +-deprecated({pid, 1, next_major_release}). --include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). @@ -134,20 +131,13 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). -connect(Host, Port, Options0, Timeout) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_connect(Host, Port, Options0, Timeout); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_connect(Host, Port, Options, Timeout); - Value -> - {error, {eoptions, {ssl_imp, Value}}} +connect(Host, Port, Options, Timeout) -> + try handle_options(Options, client) of + {ok, Config} -> + do_connect(Host,Port,Config,Timeout) + catch + throw:Error -> + Error end. %%-------------------------------------------------------------------- @@ -159,21 +149,19 @@ connect(Host, Port, Options0, Timeout) -> listen(_Port, []) -> {error, enooptions}; listen(Port, Options0) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_listen(Port, Options0); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_listen(Port, Options); - Value -> - {error, {eoptions, {ssl_imp, Value}}} + try + {ok, Config} = handle_options(Options0, server), + #config{cb={CbModule, _, _, _},inet_user=Options} = Config, + case CbModule:listen(Port, Options) of + {ok, ListenSocket} -> + {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; + Err = {error, _} -> + Err + end + catch + Error = {error, _} -> + Error end. - %%-------------------------------------------------------------------- -spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}. @@ -185,8 +173,7 @@ listen(Port, Options0) -> transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}, - fd = new_ssl}, Timeout) -> +transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) -> %% The setopt could have been invoked on the listen socket %% and options should be inherited. @@ -208,12 +195,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} end; {error, Reason} -> {error, Reason} - end; - -transport_accept(#sslsocket{} = ListenSocket, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(acceptor), - ssl_broker:transport_accept(Pid, ListenSocket, Timeout). + end. %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. @@ -227,16 +209,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) -> ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) -> +ssl_accept(#sslsocket{} = Socket, Timeout) -> ssl_connection:handshake(Socket, Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> - ssl_accept(ListenSocket, SslOptions, infinity); - -%% Old ssl -ssl_accept(#sslsocket{} = Socket, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:ssl_accept(Socket, Timeout). + ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), @@ -257,25 +234,18 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) -> +close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> CbMod:close(ListenSocket); -close(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:close(Pid); -close(Socket = #sslsocket{}) -> - ensure_old_ssl_started(), - ssl_broker:close(Socket). +close(#sslsocket{pid = Pid}) -> + ssl_connection:close(Pid). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid, fd = new_ssl}, Data) -> - ssl_connection:send(Pid, Data); - -send(#sslsocket{} = Socket, Data) -> - ensure_old_ssl_started(), - ssl_broker:send(Socket, Data). +send(#sslsocket{pid = Pid}, Data) -> + ssl_connection:send(Pid, Data). %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -286,11 +256,7 @@ send(#sslsocket{} = Socket, Data) -> recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) -> - ssl_connection:recv(Pid, Length, Timeout); - -recv(Socket = #sslsocket{}, Length, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:recv(Socket, Length, Timeout). + ssl_connection:recv(Pid, Length, Timeout). %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -298,13 +264,8 @@ recv(Socket = #sslsocket{}, Length, Timeout) -> %% Description: Changes process that receives the messages when active = true %% or once. %%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid, fd = new_ssl}, NewOwner) - when is_pid(Pid) -> - ssl_connection:new_user(Pid, NewOwner); - -controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> - ensure_old_ssl_started(), - ssl_broker:controlling_process(Socket, NewOwner). +controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) -> + ssl_connection:new_user(Pid, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -312,82 +273,31 @@ controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> %% %% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:info(Pid); +connection_info(#sslsocket{pid = Pid}) -> + ssl_connection:info(Pid). -connection_info(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:connection_info(Socket). +%%-------------------------------------------------------------------- +-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +%% +%% Description: same as inet:peername/1. +%%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid}) -> + ssl_connection:peername(Pid). %%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, der_cert()} | {error, reason()}. +-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- -peercert(Socket) -> - peercert(Socket, []). - -peercert(#sslsocket{pid = Pid, fd = new_ssl}, Opts) -> +peercert(#sslsocket{pid = Pid}) -> case ssl_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; - {ok, BinCert} -> - decode_peercert(BinCert, Opts); - {error, Reason} -> - {error, Reason} - end; - -peercert(#sslsocket{} = Socket, Opts) -> - ensure_old_ssl_started(), - case ssl_broker:peercert(Socket) of - {ok, Bin} -> - decode_peercert(Bin, Opts); - {error, Reason} -> - {error, Reason} - end. - - -decode_peercert(BinCert, Opts) -> - PKOpts = [case Opt of ssl -> otp; pkix -> plain end || - Opt <- Opts, Opt =:= ssl orelse Opt =:= pkix], - case PKOpts of - [Opt] -> - select_part(Opt, public_key:pkix_decode_cert(BinCert, Opt), Opts); - [] -> - {ok, BinCert} - end. - -select_part(otp, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'OTPCertificate'.tbsCertificate, - {ok, TBS#'OTPTBSCertificate'.subject}; - false -> - {ok, Cert} - end; - -select_part(plain, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'Certificate'.tbsCertificate, - {ok, TBS#'TBSCertificate'.subject}; - false -> - {ok, Cert} + Result -> + Result end. %%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: same as inet:peername/1. -%%-------------------------------------------------------------------- -peername(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:peername(Pid); - -peername(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:peername(Socket). - -%%-------------------------------------------------------------------- -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()]. @@ -410,9 +320,9 @@ cipher_suites(openssl) -> %% %% Description: Gets options %%-------------------------------------------------------------------- -getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> +getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> +getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> try inet:getopts(ListenSocket, OptionTags) of {ok, _} = Result -> Result; @@ -422,18 +332,15 @@ getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_l _:_ -> {error, {eoptions, {inet_options, OptionTags}}} end; -getopts(#sslsocket{fd = new_ssl}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}; -getopts(#sslsocket{} = Socket, OptionTags) -> - ensure_old_ssl_started(), - ssl_broker:getopts(Socket, OptionTags). +getopts(#sslsocket{}, OptionTags) -> + {error, {eoptions, {inet_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. %% %% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> +setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> try proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Options0) of Options -> @@ -443,7 +350,7 @@ setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list {error, {eoptions, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> try inet:setopts(ListenSocket, Options) of ok -> ok; @@ -453,20 +360,17 @@ setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list _:Error -> {error, {eoptions, {inet_options, Options, Error}}} end; -setopts(#sslsocket{fd = new_ssl}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}; -setopts(#sslsocket{} = Socket, Options) -> - ensure_old_ssl_started(), - ssl_broker:setopts(Socket, Options). +setopts(#sslsocket{}, Options) -> + {error, {eoptions,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) -> CbMod:shutdown(ListenSocket, How); -shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- @@ -474,25 +378,11 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}) -> +sockname(#sslsocket{pid = {ListenSocket, _}}) -> inet:sockname(ListenSocket); -sockname(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:sockname(Pid); - -sockname(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:sockname(Socket). - -%%--------------------------------------------------------------- --spec seed(term()) ->term(). -%% -%% Description: Only used by old ssl. -%%-------------------------------------------------------------------- -%% TODO: crypto:seed ? -seed(Data) -> - ensure_old_ssl_started(), - ssl_server:seed(Data). +sockname(#sslsocket{pid = Pid}) -> + ssl_connection:sockname(Pid). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -548,63 +438,6 @@ format_error(esslconnect) -> format_error({eoptions, Options}) -> lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); -%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -format_error(ebadsocket) -> - "Connection not found (internal error)."; -format_error(ebadstate) -> - "Connection not in connect state (internal error)."; -format_error(ebrokertype) -> - "Wrong broker type (internal error)."; -format_error(echaintoolong) -> - "The chain of certificates provided by peer is too long."; -format_error(ecipher) -> - "Own list of specified ciphers is invalid."; -format_error(ekeymismatch) -> - "Own private key does not match own certificate."; -format_error(enoissuercert) -> - "Cannot find certificate of issuer of certificate provided by peer."; -format_error(enoservercert) -> - "Attempt to do accept without having set own certificate."; -format_error(enotlistener) -> - "Attempt to accept on a non-listening socket."; -format_error(enoproxysocket) -> - "No proxy socket found (internal error or max number of file " - "descriptors exceeded)."; -format_error(enooptions) -> - "List of options is empty."; -format_error(enotstarted) -> - "The SSL application has not been started."; -format_error(eoptions) -> - "Invalid list of options."; -format_error(epeercert) -> - "Certificate provided by peer is in error."; -format_error(epeercertexpired) -> - "Certificate provided by peer has expired."; -format_error(epeercertinvalid) -> - "Certificate provided by peer is invalid."; -format_error(eselfsignedcert) -> - "Certificate provided by peer is self signed."; -format_error(esslerrssl) -> - "SSL protocol failure. Typically because of a fatal alert from peer."; -format_error(ewantconnect) -> - "Protocol wants to connect, which is not supported in this " - "version of the SSL application."; -format_error(ex509lookup) -> - "Protocol wants X.509 lookup, which is not supported in this " - "version of the SSL application."; -format_error({badcall, _Call}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; -format_error({badcast, _Cast}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -format_error({badinfo, _Info}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - format_error(Error) -> case (catch inet:format_error(Error)) of "unkknown POSIX" ++ _ -> @@ -618,16 +451,7 @@ format_error(Error) -> %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- -new_connect(Address, Port, Options, Timeout) when is_list(Options) -> - try handle_options(Options, client) of - {ok, Config} -> - do_new_connect(Address,Port,Config,Timeout) - catch - throw:Error -> - Error - end. - -do_new_connect(Address, Port, +do_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> @@ -647,35 +471,9 @@ do_new_connect(Address, Port, {error, {eoptions, {inet_options, UserOpts}}} end. -old_connect(Address, Port, Options, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(connector), - ssl_broker:connect(Pid, Address, Port, Options, Timeout). - -new_listen(Port, Options0) -> - try - {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _, _},inet_user=Options} = Config, - case CbModule:listen(Port, Options) of - {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; - Err = {error, _} -> - Err - end - catch - Error = {error, _} -> - Error - end. - -old_listen(Port, Options) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(listener), - ssl_broker:listen(Pid, Port, Options). - handle_options(Opts0, _Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), - ReuseSessionFun = fun(_, _, _, _) -> true end, DefaultVerifyNoneFun = @@ -742,7 +540,8 @@ handle_options(Opts0, _Role) -> secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), debug = handle_option(debug, Opts, []), - hibernate_after = handle_option(hibernate_after, Opts, undefined) + hibernate_after = handle_option(hibernate_after, Opts, undefined), + erl_dist = handle_option(erl_dist, Opts, false) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -751,7 +550,7 @@ handle_options(Opts0, _Role) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after], + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -768,8 +567,6 @@ handle_option(OptionName, Opts, Default) -> validate_option(versions, Versions) -> validate_versions(Versions, Versions); -validate_option(ssl_imp, Value) when Value == new; Value == old -> - Value; validate_option(verify, Value) when Value == verify_none; Value == verify_peer -> Value; @@ -811,8 +608,11 @@ validate_option(certfile, Value) when Value == undefined; is_list(Value) -> validate_option(key, undefined) -> undefined; validate_option(key, {KeyType, Value}) when is_binary(Value), - KeyType == rsa; - KeyType == dsa -> + KeyType == rsa; %% Backwards compatibility + KeyType == dsa; %% Backwards compatibility + KeyType == 'RSAPrivateKey'; + KeyType == 'DSAPrivateKey'; + KeyType == 'PrivateKeyInfo' -> {KeyType, Value}; validate_option(keyfile, Value) when is_list(Value) -> Value; @@ -862,6 +662,9 @@ validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; +validate_option(erl_dist,Value) when Value == true; + Value == false -> + Value; validate_option(Opt, Value) -> throw({error, {eoptions, {Opt, Value}}}). @@ -909,7 +712,6 @@ emulated_options() -> internal_inet_values() -> [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - %%[{packet, ssl},{header, 0},{active, false},{mode,binary}]. socket_options(InetValues) -> #socket_options{ @@ -970,47 +772,14 @@ cipher_suites(Version, Ciphers0) -> no_format(Error) -> lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). - -%% Start old ssl port program if needed. -ensure_old_ssl_started() -> - case whereis(ssl_server) of - undefined -> - (catch supervisor:start_child(ssl_sup, - {ssl_server, {ssl_server, start_link, []}, - permanent, 2000, worker, [ssl_server]})); - _ -> - ok - end. - -%%%%%%%%%%%%%%%% Deprecated %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -ciphers() -> - ensure_old_ssl_started(), - case (catch ssl_server:ciphers()) of - {'EXIT', _} -> - {error, enotstarted}; - Res = {ok, _} -> - Res - end. - -version() -> - ensure_old_ssl_started(), - SSLVsn = ?VSN, - {CompVsn, LibVsn} = case (catch ssl_server:version()) of - {'EXIT', _} -> - {"", ""}; - {ok, Vsns} -> - Vsns - end, - {ok, {SSLVsn, CompVsn, LibVsn}}. - %% Only used to remove exit messages from old ssl %% First is a nonsense clause to provide some -%% backward compability for orber that uses this +%% backward compatibility for orber that uses this %% function in a none recommended way, but will %% work correctly if a valid pid is returned. +%% Deprcated to be removed in r16 pid(#sslsocket{fd = new_ssl}) -> - whereis(ssl_connection_sup); + whereis(ssl_connection_sup); pid(#sslsocket{pid = Pid}) -> - Pid. + Pid. diff --git a/lib/ssl/src/ssl_app.erl b/lib/ssl/src/ssl_app.erl index c9f81726b9..0c475a6d01 100644 --- a/lib/ssl/src/ssl_app.erl +++ b/lib/ssl/src/ssl_app.erl @@ -27,16 +27,9 @@ -export([start/2, stop/1]). -%%-------------------------------------------------------------------- --spec start(normal | {takeover, node()} | {failover, node()}, list()) -> - ignore | {ok, pid()} | {error, term()}. -%%-------------------------------------------------------------------- start(_Type, _StartArgs) -> ssl_sup:start_link(). -%-------------------------------------------------------------------- --spec stop(term())-> ok. -%%-------------------------------------------------------------------- stop(_State) -> ok. diff --git a/lib/ssl/src/ssl_broker.erl b/lib/ssl/src/ssl_broker.erl deleted file mode 100644 index 7ef88baf2b..0000000000 --- a/lib/ssl/src/ssl_broker.erl +++ /dev/null @@ -1,1188 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2010. 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% -%% - -%% - -%%% Purpose : SSL broker - --module(ssl_broker). --behaviour(gen_server). - -%% This module implements brokers for ssl. A broker is either a connector, -%% an acceptor, or a listener. All brokers are children to ssl_broker_sup, -%% to which they are linked. Each broker is also linked to ssl_server, and -%% to its client. -%% -%% The purpose of the broker is to set up SSL connections through calls to -%% ssl_server and gen_tcp. All control information goes to the server, -%% while all data is exchanged directly between gen_tcp and the port program -%% of the ssl_server. -%% -%% A broker is created by a call to start_broker/3 (do *not* use start_link/4 -%% - it is for ssl_broker_sup to call that one), and then call listen/3, -%% accept/4, or connect/5. -%% -%% The following table shows all functions dependency on status, active -%% mode etc. -%% -%% Permitted status transitions: -%% -%% nil -> open -%% open -> closing | closed (termination) -%% closing -> closed (termination) -%% -%% We are rather sloppy about nil, and consider open/closing == !closed, -%% open/closing/closed === any etc. -%% -%% -%% function/ valid mode new -%% message status state -%% -%% calls -%% ----- -%% recv open passive ditto -%% send open any ditto -%% transport_accept nil any open -%% ssl_accept nil any open -%% connect nil any open -%% listen nil any open -%% peername open/closing any ditto -%% setopts open/closing any ditto -%% getopts open/closing any ditto -%% sockname open/closing any ditto -%% peercert open/closing any ditto -%% inhibit any any ditto -%% release any any ditto -%% close any any closed (1) -%% -%% info -%% ---- -%% tcp open active ditto -%% tcp_closed open | closing active closing -%% tcp_error open | closing active closing -%% -%% (1) We just terminate. -%% -%% TODO -%% -%% XXX Timeouts are not checked (integer or infinity). -%% -%% XXX The collector thing is not gen_server compliant. -%% -%% NOTE: There are three different "modes": (a) passive or active mode, -%% specified as {active, bool()}, and (b) list or binary mode, specified -%% as {mode, list | binary}, and (c) encrypted or clear mode -%% - --include("ssl_int.hrl"). - -%% External exports - --export([start_broker/1, start_broker/2, start_link/3, - transport_accept/3, ssl_accept/2, - close/1, connect/5, connection_info/1, controlling_process/2, - listen/3, recv/3, send/2, getopts/2, getopts/3, setopts/2, - sockname/1, peername/1, peercert/1]). - --export([listen_prim/5, connect_prim/8, - transport_accept_prim/5, ssl_accept_prim/6]). - -%% Internal exports - --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2, collector_init/1]). - --include("ssl_broker_int.hrl"). - -%% start_broker(Type) -> {ok, Pid} | {error, Reason} -%% start_broker(Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This is the function to be called from the interface module ssl.erl. -%% Links to the caller. -%% -start_broker(Type) -> - start_broker(Type, []). - -start_broker(Type, GenOpts) -> - case lists:member(Type, [listener, acceptor, connector]) of - true -> - case supervisor:start_child(ssl_broker_sup, - [self(), Type, GenOpts]) of - {ok, Pid} -> - link(Pid), - {ok, Pid}; - {error, Reason} -> - {error, Reason} - end; - false -> - {error, ebrokertype} - end. - -%% start_link(Client, Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This function is called by ssl_broker_sup and must *not* be called -%% from an interface module (ssl.erl). - -start_link(Client, Type, GenOpts) -> - gen_server:start_link(?MODULE, [Client, Type], GenOpts). - - -%% accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -%% accept(Pid, ListenSocket, Timeout) -%% when is_pid(Pid), is_record(ListenSocket, sslsocket) -> -%% Req = {accept, self(), ListenSocket, Timeout}, -%% gen_server:call(Pid, Req, infinity). - -%% transport_accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -transport_accept(Pid, #sslsocket{} = ListenSocket, Timeout) when is_pid(Pid) -> - Req = {transport_accept, self(), ListenSocket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% ssl_accept(Pid, Socket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -ssl_accept(#sslsocket{pid = Pid} = Socket, Timeout) -> - Req = {ssl_accept, self(), Socket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% close(Socket) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() | pid() -%% -close(#sslsocket{pid = Pid}) -> - close(Pid); -close(Pid) when is_pid(Pid) -> - gen_server:call(Pid, {close, self()}, infinity). - -%% connect(Pid, Address, Port, Opts, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of connector -%% Address = string() | {byte(), byte(), byte(), byte()} -%% Port = int() -%% Opts = options() -%% Timeout = timeout() -%% Socket = sslsocket() -%% -connect(Pid, Address, Port, Opts, Timeout) when is_pid(Pid), is_list(Opts) -> - case are_connect_opts(Opts) of - true -> - Req = {connect, self(), Address, Port, Opts, Timeout}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - -%% -%% connection_info(Socket) -> {ok, {Protocol, Cipher} | {error, Reason} -%% -connection_info(#sslsocket{pid = Pid}) -> - Req = {connection_info, self()}, - gen_server:call(Pid, Req, infinity). - -%% controlling_process(Socket, NewOwner) -> ok | {error, Reason} - -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(NewOwner) -> - case gen_server:call(Pid, {inhibit_msgs, self()}, infinity) of - ok -> - transfer_messages(Pid, NewOwner), - gen_server:call(Pid, {release_msgs, self(), NewOwner}, infinity); - Error -> - Error - end. - -%% listen(Pid, Port, Opts) -> {ok, ListenSocket} | {error, Reason} -%% -%% Types: Pid = pid() of listener -%% Port = int() -%% Opts = options() -%% ListenSocket = sslsocket() -%% -listen(Pid, Port, Opts) when is_pid(Pid) -> - case are_listen_opts(Opts) of - true -> - Req = {listen, self(), Port, Opts}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - - -%% -%% peername(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(#sslsocket{pid = Pid}) -> - Req = {peername, self()}, - gen_server:call(Pid, Req, infinity). - - -%% recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% Length = Timeout = integer() -%% Data = bytes() | binary() -%% -recv(#sslsocket{pid = Pid}, Length, Timeout) -> - Req = {recv, self(), Length, Timeout}, - gen_server:call(Pid, Req, infinity). - - -%% send(Socket, Data) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% -send(#sslsocket{pid = Pid}, Data) -> - gen_server:call(Pid, {send, self(), Data}, infinity). - - -%% getopts(Socket, OptTags) -> {ok, Opts} | {error, einval} -%% -%% Types: Pid = pid() of broker -%% Timeout = timeout() -%% OptTags = option_tags() -%% Opts = options() -%% -getopts(Socket, OptTags) -> - getopts(Socket, OptTags, infinity). - -getopts(#sslsocket{pid = Pid}, OptTags, Timeout) when is_list(OptTags) -> - Req = {getopts, self(), OptTags}, - gen_server:call(Pid, Req, Timeout). - - -%% -%% setopts(Socket, Opts) -> ok | {error, Reason} -%% -setopts(#sslsocket{pid = Pid}, Opts) -> - Req = {setopts, self(), Opts}, - gen_server:call(Pid, Req, infinity). - -%% -%% sockname(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(#sslsocket{pid = Pid}) -> - Req = {sockname, self()}, - gen_server:call(Pid, Req, infinity). - - -%% -%% peercert(Socket) -> {ok, Cert} | {error, Reason} -%% -peercert(#sslsocket{pid = Pid}) -> - Req = {peercert, self()}, - gen_server:call(Pid, Req, infinity). - -%% -%% INIT -%% - -%% init -%% -init([Client, Type]) -> - process_flag(trap_exit, true), - link(Client), - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - Server = whereis(ssl_server), - if - is_pid(Server) -> - link(Server), - debug1(Debug, Type, "in start, client = ~w", [Client]), - {ok, #st{brokertype = Type, server = Server, client = Client, - collector = Client, debug = Debug}}; - true -> - {stop, no_ssl_server} - end. - - -%% -%% HANDLE CALL -%% - -%% recv - passive mode -%% -handle_call({recv, Client, Length, Timeout}, _From, - #st{active = false, proxysock = Proxysock, status = Status} = St) -> - debug(St, "recv: client = ~w~n", [Client]), - if - Status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:recv(Proxysock, Length, Timeout) of - {ok, Data} -> - {reply, {ok, Data}, St}; - {error, timeout} -> - {reply, {error, timeout}, St}; - {error, Reason} -> - {reply, {error, Reason}, St#st{status = closing}} - end - end; - -%% send -%% -handle_call({send, Client, Data}, _From, St) -> - debug(St, "send: client = ~w~n", [Client]), - if - St#st.status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:send(St#st.proxysock, Data) of - ok -> - {reply, ok, St}; - {error, _Reason} -> - {reply, {error, closed}, St#st{status = closing}} - end - end; - -%% transport_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({transport_accept, Client, ListenSocket, Timeout}, _From, St) -> - debug(St, "transport_accept: client = ~w, listensocket = ~w~n", - [Client, ListenSocket]), - case getopts(ListenSocket, tcp_listen_opt_tags(), ?DEF_TIMEOUT) of - {ok, LOpts} -> - case transport_accept_prim( - ssl_server, ListenSocket#sslsocket.fd, LOpts, Timeout, St) of - {ok, ThisSocket, NSt} -> - {reply, {ok, ThisSocket}, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - {error, Reason} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% ssl_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({ssl_accept, Client, Socket, Timeout}, _From, St) -> - debug(St, "ssl_accept: client = ~w, socket = ~w~n", [Client, Socket]), - case ssl_accept_prim(ssl_server, gen_tcp, Client, St#st.opts, Timeout, St#st{thissock=Socket}) of - {ok, Socket, NSt} -> - {reply, ok, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% connect -%% -%% Client = client pid -%% Address = hostname | ipstring | IP -%% Port = integer() -%% Opts = options() -%% -handle_call({connect, Client, Address, Port, Opts, Timeout}, _From, St) -> - debug(St, "connect: client = ~w, address = ~p, port = ~w~n", - [Client, Address, Port]), - case connect_prim(ssl_server, gen_tcp, Client, Address, Port, Opts, - Timeout, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% connection_info -%% -handle_call({connection_info, Client}, _From, St) -> - debug(St, "connection_info: client = ~w~n", [Client]), - Reply = ssl_server:connection_info(St#st.fd), - {reply, Reply, St}; - -%% close from client -%% -handle_call({close, Client}, _From, St) -> - debug(St, "close: client = ~w~n", [Client]), - %% Terminate - {stop, normal, ok, St#st{status = closed}}; - -%% listen -%% -%% Client = pid of client -%% Port = int() -%% Opts = options() -%% -handle_call({listen, Client, Port, Opts}, _From, St) -> - debug(St, "listen: client = ~w, port = ~w~n", - [Client, Port]), - case listen_prim(ssl_server, Client, Port, Opts, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% peername -%% -handle_call({peername, Client}, _From, St) -> - debug(St, "peername: client = ~w~n", [Client]), - Reply = case ssl_server:peername(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% setopts -%% -handle_call({setopts, Client, Opts0}, _From, St0) -> - debug(St0, "setopts: client = ~w~n", [Client]), - OptsOK = case St0#st.brokertype of - listener -> - are_opts(fun is_tcp_listen_opt/1, Opts0); - acceptor -> - are_opts(fun is_tcp_accept_opt/1, Opts0); - connector -> - are_opts(fun is_tcp_connect_opt/1, Opts0) - end, - if - OptsOK =:= false -> - {reply, {error, eoptions}, St0}; - true -> - Opts1 = lists:keydelete(nodelay, 1, Opts0), - case inet:setopts(St0#st.proxysock, Opts1) of - ok -> - Opts2 = replace_opts(Opts1, St0#st.opts), - Active = get_active(Opts2), - St2 = St0#st{opts = Opts2, - active = Active}, - case get_nodelay(Opts0) of - empty -> - {reply, ok, St2}; - Bool -> - case setnodelay(ssl_server, St0, Bool) of - ok -> - Opts3 = replace_opts([{nodelay, Bool}], - Opts2), - St3 = St0#st{opts = Opts3, - active = Active}, - {reply, ok, St3}; - {error, Reason} -> - {reply, {error, Reason}, St2} - end - end; - {error, Reason} -> - {reply, {error, Reason}, St0} - end - end; - -%% sockname -%% -handle_call({sockname, Client}, _From, St) -> - debug(St, "sockname: client = ~w~n", [Client]), - Reply = case ssl_server:sockname(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% peercert -%% -handle_call({peercert, Client}, _From, St) -> - debug(St, "peercert: client = ~w~n", [Client]), - Reply = ssl_server:peercert(St#st.fd), - {reply, Reply, St}; - -%% inhibit msgs -%% -handle_call({inhibit_msgs, Client}, _From, #st{client = Client} = St) -> - debug(St, "inhibit_msgs: client = ~w~n", [Client]), - {ok, Collector} = start_collector(), - {reply, ok, St#st{collector = Collector}}; - -%% release msgs -%% -handle_call({release_msgs, Client, NewClient}, _From, - #st{client = Client, collector = Collector} = St) -> - debug(St, "release_msgs: client = ~w~n", [Client]), - unlink(Client), - link(NewClient), - release_collector(Collector, NewClient), - NSt = St#st{client = NewClient, collector = NewClient}, - {reply, ok, NSt}; - -%% getopts -%% -handle_call({getopts, Client, OptTags}, _From, St) -> - debug(St, "getopts: client = ~w~n", [Client]), - Reply = case are_opt_tags(St#st.brokertype, OptTags) of - true -> - {ok, extract_opts(OptTags, St#st.opts)}; - _ -> - {error, einval} - end, - {reply, Reply, St}; - -%% bad call -%% -handle_call(Request, _From, St) -> - debug(St, "++++ ssl_broker: bad call: ~w~n", [Request]), - {reply, {error, {badcall, Request}}, St}. - -%% -%% HANDLE CAST -%% - -handle_cast(Request, St) -> - debug(St, "++++ ssl_broker: bad cast: ~w~n", [Request]), - {stop, {error, {badcast, Request}}, St}. - -%% -%% HANDLE INFO -%% - -%% tcp - active mode -%% -%% The collector is different from client only during change of -%% controlling process. -%% -handle_info({tcp, Socket, Data}, - #st{active = Active, collector = Collector, status = open, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp: socket = ~w~n", [Socket]), - Msg = {ssl, Thissock, Data}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{active = false}}; - true -> - {noreply, St} - end; - -%% tcp_closed - from proxy socket, active mode -%% -%% -handle_info({tcp_closed, Socket}, - #st{active = Active, collector = Collector, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp_closed: socket = ~w~n", [Socket]), - Msg = {ssl_closed, Thissock}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% tcp_error - from proxy socket, active mode -%% -%% -handle_info({tcp_error, Socket, Reason}, - #st{active = Active, collector = Collector, - proxysock = Socket} = St) - when Active =/= false -> - debug(St, "tcp_error: socket = ~w, reason = ~w~n", [Socket, Reason]), - Msg = {ssl_error, Socket, Reason}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% EXIT - from client -%% -%% -handle_info({'EXIT', Client, Reason}, #st{client = Client} = St) -> - debug(St, "exit client: client = ~w, reason = ~w~n", [Client, Reason]), - {stop, normal, St#st{status = closed}}; % do not make noise - -%% EXIT - from server -%% -%% -handle_info({'EXIT', Server, Reason}, #st{server = Server} = St) -> - debug(St, "exit server: reason = ~w~n", [Reason]), - {stop, Reason, St}; - -%% handle info catch all -%% -handle_info(Info, St) -> - debug(St, " bad info: ~w~n", [Info]), - {stop, {error, {badinfo, Info}}, St}. - - -%% terminate -%% -%% -terminate(Reason, St) -> - debug(St, "in terminate reason: ~w, state: ~w~n", [Reason, St]), - ok. - -%% code_change -%% -%% -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% -%% Primitive interface -%% -listen_prim(ServerName, Client, Port, Opts, St) -> - LOpts = get_tcp_listen_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr =mk_ssl_optstr(SSLOpts), - BackLog = get_backlog(LOpts), - IP = get_ip(LOpts), - case ssl_server:listen_prim(ServerName, IP, Port, FlagStr, BackLog) of - {ok, ListenFd, _Port0} -> - ThisSocket = #sslsocket{fd = ListenFd, pid = self()}, - StOpts = add_default_tcp_listen_opts(LOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = ListenFd, - active = get_active(LOpts), % irrelevant for listen - opts = StOpts, - thissock = ThisSocket, - status = open}, - debug(St, "listen: ok: client = ~w, listenfd = ~w~n", - [Client, ListenFd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end. - -connect_prim(ServerName, TcpModule, Client, FAddress, FPort, Opts, - Timeout, St) -> - COpts = get_tcp_connect_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr = mk_ssl_optstr(SSLOpts), - case inet:getaddr(FAddress, inet) of - {ok, FIP} -> - %% Timeout is gen_server timeout - hence catch - LIP = get_ip(COpts), - LPort = get_port(COpts), - case (catch ssl_server:connect_prim(ServerName, - LIP, LPort, FIP, FPort, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - case connect_proxy(ServerName, TcpModule, Fd, - ProxyPort, COpts, Timeout) of - {ok, Socket} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - StOpts = add_default_tcp_connect_opts(COpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = Fd, - active = get_active(COpts), - opts = StOpts, - thissock = ThisSocket, - proxysock = Socket, - status = open}, - case get_nodelay(COpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "connect: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end; - {error, Reason} -> - {error, Reason, St} - end. - -transport_accept_prim(ServerName, ListenFd, LOpts, Timeout, St) -> - AOpts = get_tcp_accept_opts(LOpts), - FlagStr = "", - %% Timeout is gen_server timeout - hence catch. - case (catch ssl_server:transport_accept_prim(ServerName, ListenFd, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - NSt = St#st{fd = Fd, - active = get_active(AOpts), - opts = AOpts, - thissock = ThisSocket, - proxyport = ProxyPort, - encrypted = false}, - debug(St, "transport_accept: ok: fd = ~w~n", [Fd]), - {ok, ThisSocket, NSt}; - {'EXIT', Reason} -> - debug(St, "transport_accept: EXIT: Reason = ~w~n", [Reason]), - {error, Reason, St}; - {error, Reason} -> - debug(St, "transport_accept: error: Reason = ~w~n", [Reason]), - {error, Reason, St} - end. - -ssl_accept_prim(ServerName, TcpModule, Client, LOpts, Timeout, St) -> - FlagStr = [], - SSLOpts = [], - AOpts = get_tcp_accept_opts(LOpts), - %% Timeout is gen_server timeout - hence catch. - debug(St, "ssl_accept_prim: self() ~w Client ~w~n", [self(), Client]), - Socket = St#st.thissock, - Fd = Socket#sslsocket.fd, - A = (catch ssl_server:ssl_accept_prim(ServerName, Fd, FlagStr, Timeout)), - debug(St, "ssl_accept_prim: ~w~n", [A]), - case A of - ok -> - B = connect_proxy(ServerName, TcpModule, Fd, - St#st.proxyport, AOpts, Timeout), - debug(St, "ssl_accept_prim: connect_proxy ~w~n", [B]), - case B of - {ok, Socket2} -> - StOpts = add_default_tcp_accept_opts(AOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{opts = StOpts, - proxysock = Socket2, - encrypted = true, - status = open}, - case get_nodelay(AOpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "transport_accept: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, St#st.thissock, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end. - - -%% -%% LOCAL FUNCTIONS -%% - -%% -%% connect_proxy(Fd, ProxyPort, TOpts, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -connect_proxy(ServerName, TcpModule, Fd, ProxyPort, TOpts, Timeout) -> - case TcpModule:connect({127, 0, 0, 1}, ProxyPort, TOpts, Timeout) of - {ok, Socket} -> - {ok, Port} = inet:port(Socket), - A = ssl_server:proxy_join_prim(ServerName, Fd, Port), - case A of - ok -> - {ok, Socket}; - Error -> - Error - end; - Error -> - Error - end. - - -setnodelay(ServerName, St, Bool) -> - case ssl_server:setnodelay_prim(ServerName, St#st.fd, Bool) of - ok -> - case inet:setopts(St#st.proxysock, [{nodelay, Bool}]) of - ok -> - ok; - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -%% -%% start_collector() -%% -%% A collector is a little process that keeps messages during change of -%% controlling process. -%% XXX This is not gen_server compliant :-(. -%% -start_collector() -> - Pid = spawn_link(?MODULE, collector_init, [self()]), - {ok, Pid}. - -%% -%% release_collector(Collector, NewOwner) -%% -release_collector(Collector, NewOwner) -> - Collector ! {release, self(), NewOwner}, - receive - %% Reap collector - {'EXIT', Collector, normal} -> - ok - end. - -%% -%% collector_init(Broker) -> void() -%% -collector_init(Broker) -> - receive - {release, Broker, NewOwner} -> - transfer_messages(Broker, NewOwner) - end. - -%% -%% transfer_messages(Pid, NewOwner) -> void() -%% -transfer_messages(Pid, NewOwner) -> - receive - {ssl, Sock, Data} -> - NewOwner ! {ssl, Sock, Data}, - transfer_messages(Pid, NewOwner); - {ssl_closed, Sock} -> - NewOwner ! {ssl_closed, Sock}, - transfer_messages(Pid, NewOwner); - {ssl_error, Sock, Reason} -> - NewOwner ! {ssl_error, Sock, Reason}, - transfer_messages(Pid, NewOwner) - after 0 -> - ok - end. - -%% -%% debug(St, Format, Args) -> void() - printouts -%% -debug(St, Format, Args) -> - debug1(St#st.debug, St#st.brokertype, Format, Args). - -debug1(true, Type, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_broker (~w)[~w]: " ++ Format0, - io:format(Format, [Secs, MiSecs, self(), Type| Args]); -debug1(_, _, _, _) -> - ok. - -%% -%% what(Reason) -> What -%% -what(Reason) when is_atom(Reason) -> - Reason; -what({'EXIT', Reason}) -> - what(Reason); -what({What, _Where}) when is_atom(What) -> - What; -what(Reason) -> - Reason. - - -%% -%% OPTIONS -%% -%% Note that `accept' has no options when invoked, but get all its options -%% by inheritance from `listen'. -%% - -are_opt_tags(listener, OptTags) -> - is_subset(OptTags, listen_opt_tags()); -are_opt_tags(acceptor, OptTags) -> - is_subset(OptTags, accept_opt_tags()); -are_opt_tags(connector, OptTags) -> - is_subset(OptTags, connect_opt_tags()). - -listen_opt_tags() -> - tcp_listen_opt_tags() ++ ssl_opt_tags(). - -accept_opt_tags() -> - tcp_gen_opt_tags(). - -connect_opt_tags() -> - tcp_gen_opt_tags() ++ ssl_opt_tags(). - -tcp_listen_opt_tags() -> - tcp_gen_opt_tags() ++ tcp_listen_only_opt_tags(). - -tcp_gen_opt_tags() -> - %% All except `reuseaddr' and `deliver'. - [nodelay, active, packet, mode, header]. - -tcp_listen_only_opt_tags() -> - [ip, backlog]. - -ssl_opt_tags() -> - %% XXX Should remove cachetimeout. - [verify, depth, certfile, password, cacertfile, ciphers, cachetimeout]. - -%% Options - -%% -%% are_*_opts(Opts) -> boolean() -%% -are_connect_opts(Opts) -> - are_opts(fun is_connect_opt/1, Opts). - -are_listen_opts(Opts) -> - are_opts(fun is_listen_opt/1, Opts). - -are_opts(F, Opts) -> - lists:all(F, transform_opts(Opts)). - -%% -%% get_*_opts(Opts) -> Value -%% -get_tcp_accept_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_accept_opt(O)]. - -get_tcp_connect_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_connect_opt(O)]. - -get_tcp_listen_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_listen_opt(O)]. - -get_ssl_opts(Opts) -> - [O || O <- transform_opts(Opts), is_ssl_opt(O)]. - -get_active(Opts) -> - get_tagged_opt(active, Opts, true). - -get_backlog(Opts) -> - get_tagged_opt(backlog, Opts, ?DEF_BACKLOG). - -get_ip(Opts) -> - get_tagged_opt(ip, Opts, {0, 0, 0, 0}). - -get_port(Opts) -> - get_tagged_opt(port, Opts, 0). - -get_nodelay(Opts) -> - get_tagged_opt(nodelay, Opts, empty). - -%% -%% add_default_*_opts(Opts) -> NOpts -%% - -add_default_tcp_accept_opts(Opts) -> - add_default_opts(Opts, default_tcp_accept_opts()). - -add_default_tcp_connect_opts(Opts) -> - add_default_opts(Opts, default_tcp_connect_opts()). - -add_default_tcp_listen_opts(Opts) -> - add_default_opts(Opts, default_tcp_listen_opts()). - -add_default_ssl_opts(Opts) -> - add_default_opts(Opts, default_ssl_opts()). - -add_default_opts(Opts, DefOpts) -> - TOpts = transform_opts(Opts), - TOpts ++ [DP || {DTag, _DVal} = DP <- DefOpts, - not lists:keymember(DTag, 1, TOpts)]. - -default_tcp_accept_opts() -> - [O || O <- default_opts(), is_tcp_accept_opt(O)]. - -default_tcp_connect_opts() -> - [O || O <- default_opts(), is_tcp_connect_opt(O)]. - -default_tcp_listen_opts() -> - [O || O <- default_opts(), is_tcp_listen_opt(O)]. - -default_ssl_opts() -> - [O || O <- default_opts(), is_ssl_opt(O)]. - -default_opts() -> - [{mode, list}, {packet, 0}, {nodelay, false}, {active, true}, - {backlog, ?DEF_BACKLOG}, {ip, {0, 0, 0, 0}}, - {verify, 0}, {depth, 1}]. - - -%% Transform from old to new options, and also from old gen_tcp -%% options to new ones. All returned options are tagged options. -%% -transform_opts(Opts) -> - lists:flatmap(fun transform_opt/1, Opts). - -transform_opt(binary) -> [{mode, binary}]; -transform_opt(list) -> [{mode, list}]; -transform_opt({packet, raw}) -> [{packet, 0}]; -transform_opt(raw) -> []; -transform_opt(Opt) -> [Opt]. - -%% NOTE: The is_*_opt/1 functions must be applied on transformed options -%% only. - -is_connect_opt(Opt) -> - is_tcp_connect_opt(Opt) or is_ssl_opt(Opt). - -is_listen_opt(Opt) -> - is_tcp_listen_opt(Opt) or is_ssl_opt(Opt). - -is_tcp_accept_opt(Opt) -> - is_tcp_gen_opt(Opt). - -is_tcp_connect_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_connect_only_opt(Opt). - -is_tcp_listen_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_listen_only_opt(Opt). - -%% General options supported by gen_tcp: All except `reuseaddr' and -%% `deliver'. -is_tcp_gen_opt({mode, list}) -> true; -is_tcp_gen_opt({mode, binary}) -> true; -is_tcp_gen_opt({header, Sz}) when is_integer(Sz), 0 =< Sz -> true; -is_tcp_gen_opt({packet, Sz}) when is_integer(Sz), 0 =< Sz, Sz =< 4-> true; -is_tcp_gen_opt({packet, sunrm}) -> true; -is_tcp_gen_opt({packet, asn1}) -> true; -is_tcp_gen_opt({packet, cdr}) -> true; -is_tcp_gen_opt({packet, fcgi}) -> true; -is_tcp_gen_opt({packet, line}) -> true; -is_tcp_gen_opt({packet, tpkt}) -> true; -is_tcp_gen_opt({packet, http}) -> true; -is_tcp_gen_opt({packet, httph}) -> true; -is_tcp_gen_opt({nodelay, true}) -> true; -is_tcp_gen_opt({nodelay, false}) -> true; -is_tcp_gen_opt({active, true}) -> true; -is_tcp_gen_opt({active, false}) -> true; -is_tcp_gen_opt({active, once}) -> true; -is_tcp_gen_opt({keepalive, true}) -> true; -is_tcp_gen_opt({keepalive, false}) -> true; -is_tcp_gen_opt({ip, Addr}) -> is_ip_address(Addr); -is_tcp_gen_opt(_Opt) -> false. - -is_tcp_listen_only_opt({backlog, Size}) when is_integer(Size), 0 =< Size -> - true; -is_tcp_listen_only_opt({reuseaddr, Bool}) when is_boolean(Bool) -> - true; -is_tcp_listen_only_opt(_Opt) -> false. - -is_tcp_connect_only_opt({port, Port}) when is_integer(Port), 0 =< Port -> true; -is_tcp_connect_only_opt(_Opt) -> false. - -%% SSL options - -is_ssl_opt({verify, Code}) when 0 =< Code, Code =< 2 -> true; -is_ssl_opt({depth, Depth}) when 0 =< Depth -> true; -is_ssl_opt({certfile, String}) -> is_string(String); -is_ssl_opt({keyfile, String}) -> is_string(String); -is_ssl_opt({password, String}) -> is_string(String); -is_ssl_opt({cacertfile, String}) -> is_string(String); -is_ssl_opt({ciphers, String}) -> is_string(String); -is_ssl_opt({cachetimeout, Timeout}) when Timeout >= 0 -> true; -is_ssl_opt(_Opt) -> false. - -%% Various types -is_string(String) when is_list(String) -> - lists:all(fun (C) when is_integer(C), 0 =< C, C =< 255 -> true; - (_C) -> false end, - String); -is_string(_) -> - false. - -is_ip_address(Addr) when tuple_size(Addr) =:= 4 -> - is_string(tuple_to_list(Addr)); -is_ip_address(Addr) when is_list(Addr) -> - is_string(Addr); -is_ip_address(_) -> - false. - -get_tagged_opt(Tag, Opts, Default) -> - case lists:keysearch(Tag, 1, Opts) of - {value, {_, Value}} -> - Value; - _Other -> - Default - end. - -%% -%% mk_ssl_optstr(Opts) -> string() -%% -%% Makes a "command line" string of SSL options -%% -mk_ssl_optstr(Opts) -> - lists:flatten([mk_one_ssl_optstr(O) || O <- Opts]). - -mk_one_ssl_optstr({verify, Code}) -> - [" -verify ", integer_to_list(Code)]; -mk_one_ssl_optstr({depth, Depth}) -> - [" -depth ", integer_to_list(Depth)]; -mk_one_ssl_optstr({certfile, String}) -> - [" -certfile ", String]; -mk_one_ssl_optstr({keyfile, String}) -> - [" -keyfile ", String]; -mk_one_ssl_optstr({password, String}) -> - [" -password ", String]; -mk_one_ssl_optstr({cacertfile, String}) -> - [" -cacertfile ", String]; -mk_one_ssl_optstr({ciphers, String}) -> - [" -ciphers ", String]; -mk_one_ssl_optstr({cachetimeout, Timeout}) -> - [" -cachetimeout ", integer_to_list(Timeout)]; -mk_one_ssl_optstr(_) -> - "". - -extract_opts(OptTags, Opts) -> - [O || O = {Tag,_} <- Opts, lists:member(Tag, OptTags)]. - -replace_opts(NOpts, Opts) -> - lists:foldl(fun({Key, Val}, Acc) -> - lists:keyreplace(Key, 1, Acc, {Key, Val}); - %% XXX Check. Patch from Chandrashekhar Mullaparthi. - (binary, Acc) -> - lists:keyreplace(mode, 1, Acc, {mode, binary}) - end, - Opts, NOpts). - -%% Misc - -is_subset(A, B) -> - [] =:= A -- B. diff --git a/lib/ssl/src/ssl_broker_int.hrl b/lib/ssl/src/ssl_broker_int.hrl deleted file mode 100644 index b791485725..0000000000 --- a/lib/ssl/src/ssl_broker_int.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. 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% -%% - -%% - -%% Purpose: record definitions shared between ssl_prim.erl and ssl_broker.erl - --record(st, {brokertype = nil, % connector | listener | acceptor - server = nil, % pid of ssl_server - client = nil, % client pid - collector = nil, % client pid, or collector during change of - % controlling process - fd = nil, % fd of "external" socket in port program - active = true, % true | false | once - opts = [], % options - thissock = nil, % this sslsocket - proxysock = nil, % local proxy socket within Erlang - proxyport = nil, % local port for proxy within Erlang - status = nil, % open | closing | closed - encrypted = false, % - debug = false % - }). diff --git a/lib/ssl/src/ssl_broker_sup.erl b/lib/ssl/src/ssl_broker_sup.erl deleted file mode 100644 index 6d56a5fcf6..0000000000 --- a/lib/ssl/src/ssl_broker_sup.erl +++ /dev/null @@ -1,46 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. 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% -%% - -%% - -%%% Purpose : Supervisor for brokers - --module(ssl_broker_sup). - --behaviour(supervisor). - --export([start_link/0]). - -%% supervisor callbacks --export([init/1]). - -start_link() -> - supervisor:start_link({local, ssl_broker_sup}, ssl_broker_sup, - []). - -init([]) -> - {ok, {{simple_one_for_one, 10, 3600}, - [{ssl_broker, - {ssl_broker, start_link, []}, - temporary, - 100, - worker, - [ssl_broker]} - ]}}. - diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 422ea6404b..61876e1158 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -66,7 +66,7 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef) -> {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, no_candidate, CertDbHandle) of + case find_issuer(OtpCert, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> @@ -193,7 +193,7 @@ certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> {_, true = SelfSigned} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, no_candidate, CertDbHandle) of + case find_issuer(OtpCert, CertDbHandle) of {ok, {SerialNr, Issuer}} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); @@ -227,17 +227,24 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned {ok, lists:reverse(Chain)} end. -find_issuer(OtpCert, PrevCandidateKey, CertDbHandle) -> - case ssl_manager:issuer_candidate(PrevCandidateKey, CertDbHandle) of - no_more_candidates -> - {error, issuer_not_found}; - {Key, {_Cert, ErlCertCandidate}} -> - case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of - true -> - public_key:pkix_issuer_id(ErlCertCandidate, self); - false -> - find_issuer(OtpCert, Key, CertDbHandle) - end +find_issuer(OtpCert, CertDbHandle) -> + IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> + case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of + true -> + throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); + false -> + Acc + end; + (_, Acc) -> + Acc + end, + + try ssl_certificate_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _IssuerId} = Return -> + Return end. is_valid_extkey_usage(KeyUse, client) -> diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 0560a02110..cb2473576a 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -26,7 +26,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([create/0, remove/1, add_trusted_certs/3, - remove_trusted_certs/2, lookup_trusted_cert/4, issuer_candidate/2, + remove_trusted_certs/2, lookup_trusted_cert/4, foldl/3, lookup_cached_certs/2, cache_pem_file/4, uncache_pem_file/2, lookup/2]). -type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. @@ -127,8 +127,6 @@ uncache_pem_file(File, [_CertsDb, _FileToRefDb, PidToFileDb]) -> exit(Pid, shutdown) end, Pids). - - %%-------------------------------------------------------------------- -spec remove_trusted_certs(pid(), [db_handle()]) -> term(). @@ -161,37 +159,6 @@ remove_trusted_certs(Pid, [CertsDb, FileToRefDb, PidToFileDb]) -> end. %%-------------------------------------------------------------------- --spec issuer_candidate(no_candidate | cert_key() | {file, term()}, term()) -> - {cert_key(),{der_cert(), #'OTPCertificate'{}}} | no_more_candidates. -%% -%% Description: If a certificat does not define its issuer through -%% the extension 'ce-authorityKeyIdentifier' we can -%% try to find the issuer in the database over known -%% certificates. -%%-------------------------------------------------------------------- -issuer_candidate(no_candidate, Db) -> - case ets:first(Db) of - '$end_of_table' -> - no_more_candidates; - {file, _} = Key -> - issuer_candidate(Key, Db); - Key -> - [Cert] = lookup(Key, Db), - {Key, Cert} - end; - -issuer_candidate(PrevCandidateKey, Db) -> - case ets:next(Db, PrevCandidateKey) of - '$end_of_table' -> - no_more_candidates; - {file, _} = Key -> - issuer_candidate(Key, Db); - Key -> - [Cert] = lookup(Key, Db), - {Key, Cert} - end. - -%%-------------------------------------------------------------------- -spec lookup(term(), db_handle()) -> term() | undefined. %% %% Description: Looks up an element in a certificat <Db>. @@ -206,7 +173,18 @@ lookup(Key, Db) -> end, [Pick(Data) || Data <- Contents] end. - +%%-------------------------------------------------------------------- +-spec foldl(fun(), term(), db_handle()) -> term(). +%% +%% Description: Calls Fun(Elem, AccIn) on successive elements of the +%% cache, starting with AccIn == Acc0. Fun/2 must return a new +%% accumulator which is passed to the next call. The function returns +%% the final value of the accumulator. Acc0 is returned if the certifate +%% db is empty. +%%-------------------------------------------------------------------- +foldl(Fun, Acc0, Cache) -> + ets:foldl(Fun, Acc0, Cache). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72f02a4362..d43d312be8 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) -> block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> - try Fun(Key, IV, Fragment) of - Text -> - GBC = generic_block_cipher_from_bin(Text, HashSz), - case is_correct_padding(GBC, Version) of - true -> - Content = GBC#generic_block_cipher.content, - Mac = GBC#generic_block_cipher.mac, - CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, - {Content, Mac, CipherState1}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end + try + Text = Fun(Key, IV, Fragment), + GBC = generic_block_cipher_from_bin(Text, HashSz), + Content = GBC#generic_block_cipher.content, + Mac = GBC#generic_block_cipher.mac, + CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, + case is_correct_padding(GBC, Version) of + true -> + {Content, Mac, CipherState1}; + false -> + %% decryption failed or invalid padding, + %% intentionally break Content to make + %% sure a packet with invalid padding + %% but otherwise correct data will fail + %% the MAC test later + {<<16#F0, Content/binary>>, Mac, CipherState1} + end catch _:_ -> %% This is a DECRYPTION_FAILED but @@ -500,14 +505,38 @@ hash_size(md5) -> hash_size(sha) -> 20. +%% RFC 5246: 6.2.3.2. CBC Block Cipher +%% +%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a +%% timing attack on CBC padding based on the time required to compute +%% the MAC. In order to defend against this attack, implementations +%% MUST ensure that record processing time is essentially the same +%% whether or not the padding is correct. In general, the best way to +%% do this is to compute the MAC even if the padding is incorrect, and +%% only then reject the packet. For instance, if the pad appears to be +%% incorrect, the implementation might assume a zero-length pad and then +%% compute the MAC. This leaves a small timing channel, since MAC +%% performance depends to some extent on the size of the data fragment, +%% but it is not believed to be large enough to be exploitable, due to +%% the large block size of existing MACs and the small size of the +%% timing signal. +%% +%% implementation note: +%% We return the original (possibly invalid) PadLength in any case. +%% An invalid PadLength will be caught by is_correct_padding/2 +%% generic_block_cipher_from_bin(T, HashSize) -> Sz1 = byte_size(T) - 1, - <<_:Sz1/binary, ?BYTE(PadLength)>> = T, + <<_:Sz1/binary, ?BYTE(PadLength0)>> = T, + PadLength = if + PadLength0 >= Sz1 -> 0; + true -> PadLength0 + end, CompressedLength = byte_size(T) - PadLength - 1 - HashSize, <<Content:CompressedLength/binary, Mac:HashSize/binary, - Padding:PadLength/binary, ?BYTE(PadLength)>> = T, + Padding:PadLength/binary, ?BYTE(PadLength0)>> = T, #generic_block_cipher{content=Content, mac=Mac, - padding=Padding, padding_length=PadLength}. + padding=Padding, padding_length=PadLength0}. generic_stream_cipher_from_bin(T, HashSz) -> Sz = byte_size(T), @@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -is_correct_padding(_, {3, 0}) -> - true; -%% For interoperability reasons we do not check the padding in TLS 1.0 as it -%% is not strictly required and breaks interopability with for instance -%% Google. -is_correct_padding(_, {3, 1}) -> - true; +%% For interoperability reasons we do not check the padding content in +%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks +%% interopability with for instance Google. +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, {3, N}) + when N == 0; N == 1 -> + Len == byte_size(Padding); %% Padding must be check in TLS 1.1 and after -is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) -> - list_to_binary(lists:duplicate(Len, Len)) == Padding. - +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, _) -> + Len == byte_size(Padding) andalso + list_to_binary(lists:duplicate(Len, Len)) == Padding. get_padding(Length, BlockSize) -> get_padding_aux(BlockSize, Length rem BlockSize). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 5187d0f78f..28dd0c85d0 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -34,7 +34,6 @@ -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). --include("ssl_int.hrl"). -include_lib("public_key/include/public_key.hrl"). %% Internal application API @@ -88,15 +87,17 @@ bytes_to_read, % integer(), # bytes to read in passive mode user_data_buffer, % binary() log_alert, % boolean() - renegotiation, % {boolean(), From | internal | peer} - recv_during_renegotiation, %boolean() - send_queue, % queue() - terminated = false % + renegotiation, % {boolean(), From | internal | peer} + recv_from, % + send_queue, % queue() + terminated = false, % + allow_renegotiate = true }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, - #'DHParameter'{prime = ?DEFAULT_DIFFIE_HELLMAN_PRIME, + #'DHParameter'{prime = ?DEFAULT_DIFFIE_HELLMAN_PRIME, base = ?DEFAULT_DIFFIE_HELLMAN_GENERATOR}). +-define(WAIT_TO_ALLOW_RENEGOTIATION, 12000). -type state_name() :: hello | abbreviated | certify | cipher | connection. -type gen_fsm_state_return() :: {next_state, state_name(), #state{}} | @@ -292,10 +293,6 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> %% gen_fsm callbacks %%==================================================================== %%-------------------------------------------------------------------- --spec init(list()) -> {ok, state_name(), #state{}, timeout()} | {stop, term()}. -%% Possible return values not used now. -%% | {ok, state_name(), #state{}} | -%% ignore %% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or %% gen_fsm:start_link/3,4, this function is called by the new process to %% initialize. @@ -304,12 +301,13 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), Hashes0 = ssl_handshake:init_hashes(), - + TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), try ssl_init(SSLOpts0, Role) of {ok, Ref, CertDbHandle, CacheHandle, OwnCert, Key, DHParams} -> Session = State0#state.session, State = State0#state{tls_handshake_hashes = Hashes0, - session = Session#session{own_certificate = OwnCert}, + session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, cert_db_ref = Ref, cert_db = CertDbHandle, session_cache = CacheHandle, @@ -322,8 +320,6 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, end. %%-------------------------------------------------------------------- -%% -spec state_name(event(), #state{}) -> gen_fsm_state_return() -%% %% Description:There should be one instance of this function for each %% possible state name. Whenever a gen_fsm receives an event sent %% using gen_fsm:send_event/2, the instance of this function with the @@ -352,19 +348,18 @@ hello(start, #state{host = Host, port = Port, role = client, State1 = State0#state{connection_states = CS2, negotiated_version = Version, %% Requested version session = - Session0#session{session_id = Hello#client_hello.session_id, - is_resumable = false}, + Session0#session{session_id = Hello#client_hello.session_id}, tls_handshake_hashes = Hashes1}, {Record, State} = next_record(State1), - next_state(hello, Record, State); + next_state(hello, hello, Record, State); hello(start, #state{role = server} = State0) -> {Record, State} = next_record(State0), - next_state(hello, Record, State); + next_state(hello, hello, Record, State); hello(#hello_request{}, #state{role = client} = State0) -> {Record, State} = next_record(State0), - next_state(hello, Record, State); + next_state(hello, hello, Record, State); hello(#server_hello{cipher_suite = CipherSuite, compression_method = Compression} = Hello, @@ -427,7 +422,7 @@ hello(Msg, State) -> %%-------------------------------------------------------------------- abbreviated(#hello_request{}, State0) -> {Record, State} = next_record(State0), - next_state(hello, Record, State); + next_state(abbreviated, hello, Record, State); abbreviated(#finished{verify_data = Data} = Finished, #state{role = server, @@ -480,7 +475,7 @@ abbreviated(Msg, State) -> %%-------------------------------------------------------------------- certify(#hello_request{}, State0) -> {Record, State} = next_record(State0), - next_state(hello, Record, State); + next_state(certify, hello, Record, State); certify(#certificate{asn1_certificates = []}, #state{role = server, negotiated_version = Version, @@ -488,7 +483,7 @@ certify(#certificate{asn1_certificates = []}, fail_if_no_peer_cert = true}} = State) -> Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), - handle_own_alert(Alert, Version, certify_certificate, State), + handle_own_alert(Alert, Version, certify, State), {stop, normal, State}; certify(#certificate{asn1_certificates = []}, @@ -497,7 +492,7 @@ certify(#certificate{asn1_certificates = []}, fail_if_no_peer_cert = false}} = State0) -> {Record, State} = next_record(State0#state{client_certificate_requested = false}), - next_state(certify, Record, State); + next_state(certify, certify, Record, State); certify(#certificate{} = Cert, #state{negotiated_version = Version, @@ -512,7 +507,7 @@ certify(#certificate{} = Cert, handle_peer_cert(PeerCert, PublicKeyInfo, State#state{client_certificate_requested = false}); #alert{} = Alert -> - handle_own_alert(Alert, Version, certify_certificate, State), + handle_own_alert(Alert, Version, certify, State), {stop, normal, State} end; @@ -523,10 +518,9 @@ certify(#server_key_exchange{} = KeyExchangeMsg, case handle_server_key(KeyExchangeMsg, State0) of #state{} = State1 -> {Record, State} = next_record(State1), - next_state(certify, Record, State); + next_state(certify, certify, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, certify_server_keyexchange, - State0), + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end; @@ -536,7 +530,7 @@ certify(#server_key_exchange{} = Msg, certify(#certificate_request{}, State0) -> {Record, State} = next_record(State0#state{client_certificate_requested = true}), - next_state(certify, Record, State); + next_state(certify, certify, Record, State); %% Master secret was determined with help of server-key exchange msg certify(#server_hello_done{}, @@ -551,8 +545,7 @@ certify(#server_hello_done{}, State = State0#state{connection_states = ConnectionStates1}, client_certify_and_key_exchange(State); #alert{} = Alert -> - handle_own_alert(Alert, Version, - certify_server_hello_done, State0), + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end; @@ -571,8 +564,7 @@ certify(#server_hello_done{}, session = Session}, client_certify_and_key_exchange(State); #alert{} = Alert -> - handle_own_alert(Alert, Version, - certify_server_hello_done, State0), + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end; @@ -589,7 +581,7 @@ certify(#client_key_exchange{exchange_keys = Keys}, certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State) catch #alert{} = Alert -> - handle_own_alert(Alert, Version, certify_client_key_exchange, State), + handle_own_alert(Alert, Version, certify, State), {stop, normal, State} end; @@ -612,10 +604,9 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS State1 = State0#state{connection_states = ConnectionStates, session = Session}, {Record, State} = next_record(State1), - next_state(cipher, Record, State); + next_state(certify, cipher, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, - certify_client_key_exchange, State0), + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end; @@ -627,10 +618,9 @@ certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPubl case dh_master_secret(crypto:mpint(P), crypto:mpint(G), ClientPublicDhKey, ServerDhPrivateKey, State0) of #state{} = State1 -> {Record, State} = next_record(State1), - next_state(cipher, Record, State); + next_state(certify, cipher, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, - certify_client_key_exchange, State0), + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end. @@ -640,7 +630,7 @@ certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPubl %%-------------------------------------------------------------------- cipher(#hello_request{}, State0) -> {Record, State} = next_record(State0), - next_state(hello, Record, State); + next_state(cipher, hello, Record, State); cipher(#certificate_verify{signature = Signature}, #state{role = server, @@ -653,7 +643,7 @@ cipher(#certificate_verify{signature = Signature}, Version, MasterSecret, Hashes) of valid -> {Record, State} = next_record(State0), - next_state(cipher, Record, State); + next_state(cipher, cipher, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, cipher, State0), {stop, normal, State0} @@ -706,20 +696,32 @@ connection(#hello_request{}, #state{host = Host, port = Port, {Record, State} = next_record(State0#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}), - next_state(hello, Record, State); -connection(#client_hello{} = Hello, #state{role = server} = State) -> - hello(Hello, State); - + next_state(connection, hello, Record, State); +connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> + %% Mitigate Computational DoS attack + %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html + %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client + %% initiated renegotiation we will disallow many client initiated + %% renegotiations immediately after each other. + erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), + hello(Hello, State#state{allow_renegotiate = false}); + +connection(#client_hello{}, #state{role = server, allow_renegotiate = false, + connection_states = ConnectionStates0, + socket = Socket, transport_cb = Transport, + negotiated_version = Version} = State0) -> + Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), + {BinMsg, ConnectionStates} = + encode_alert(Alert, Version, ConnectionStates0), + Transport:send(Socket, BinMsg), + next_state_connection(connection, State0#state{connection_states = ConnectionStates}); + connection(timeout, State) -> {next_state, connection, State, hibernate}; connection(Msg, State) -> handle_unexpected_message(Msg, connection, State). %%-------------------------------------------------------------------- --spec handle_event(term(), state_name(), #state{}) -> term(). -%% As it is not currently used gen_fsm_state_return() makes -%% dialyzer unhappy! -%% %% Description: Whenever a gen_fsm receives an event sent using %% gen_fsm:send_all_state_event/2, this function is called to handle %% the event. Not currently used! @@ -728,47 +730,16 @@ handle_event(_Event, StateName, State) -> {next_state, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec handle_sync_event(term(), from(), state_name(), #state{}) -> - gen_fsm_state_return() | - {reply, reply(), state_name(), #state{}} | - {reply, reply(), state_name(), #state{}, timeout()} | - {stop, reason(), reply(), #state{}}. -%% %% Description: Whenever a gen_fsm receives an event sent using %% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle %% the event. %%-------------------------------------------------------------------- -handle_sync_event({application_data, Data0}, From, connection, - #state{socket = Socket, - negotiated_version = Version, - transport_cb = Transport, - connection_states = ConnectionStates0, - send_queue = SendQueue, - socket_options = SockOpts, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} - = State) -> +handle_sync_event({application_data, Data}, From, connection, State) -> %% We should look into having a worker process to do this to %% parallize send and receive decoding and not block the receiver %% if sending is overloading the socket. try - Data = encode_packet(Data0, SockOpts), - case encode_data(Data, Version, ConnectionStates0, RenegotiateAt) of - {Msgs, [], ConnectionStates} -> - Result = Transport:send(Socket, Msgs), - {reply, Result, - connection, State#state{connection_states = ConnectionStates}, - get_timeout(State)}; - {Msgs, RestData, ConnectionStates} -> - if - Msgs =/= [] -> - Transport:send(Socket, Msgs); - true -> - ok - end, - renegotiate(State#state{connection_states = ConnectionStates, - send_queue = queue:in_r({From, RestData}, SendQueue), - renegotiation = {true, internal}}) - end + write_application_data(Data, From, State) catch throw:Error -> {reply, Error, connection, State, get_timeout(State)} end; @@ -825,14 +796,12 @@ handle_sync_event({shutdown, How0}, _, StateName, end; handle_sync_event({recv, N}, From, connection = StateName, State0) -> - passive_receive(State0#state{bytes_to_read = N, from = From}, StateName); + passive_receive(State0#state{bytes_to_read = N, recv_from = From}, StateName); %% Doing renegotiate wait with handling request until renegotiate is -%% finished. Will be handled by next_state_connection/2. +%% finished. Will be handled by next_state_is_connection/2. handle_sync_event({recv, N}, From, StateName, State) -> - {next_state, StateName, - State#state{bytes_to_read = N, from = From, - recv_during_renegotiation = true}, + {next_state, StateName, State#state{bytes_to_read = N, recv_from = From}, get_timeout(State)}; handle_sync_event({new_user, User}, _From, StateName, @@ -870,7 +839,7 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, Buffer =:= <<>>, Opts1#socket_options.active =:= false -> %% Need data, set active once {Record, State2} = next_record_if_active(State1), - case next_state(StateName, Record, State2) of + case next_state(StateName, StateName, Record, State2) of {next_state, StateName, State, Timeout} -> {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> @@ -880,11 +849,11 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, %% Active once already set {reply, Reply, StateName, State1, get_timeout(State1)}; true -> - case application_data(<<>>, State1) of + case read_application_data(<<>>, State1) of Stop = {stop,_,_} -> Stop; {Record, State2} -> - case next_state(StateName, Record, State2) of + case next_state(StateName, StateName, Record, State2) of {next_state, StateName, State, Timeout} -> {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> @@ -920,11 +889,6 @@ handle_sync_event(peer_certificate, _, StateName, {reply, {ok, Cert}, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec handle_info(msg(),state_name(), #state{}) -> - {next_state, state_name(), #state{}}| - {next_state, state_name(), #state{}, timeout()} | - {stop, reason(), #state{}}. -%% %% Description: This function is called by a gen_fsm when it receives any %% other message than a synchronous or asynchronous event %% (or a system message). @@ -932,22 +896,18 @@ handle_sync_event(peer_certificate, _, StateName, %% raw data from TCP, unpack records handle_info({Protocol, _, Data}, StateName, - #state{data_tag = Protocol, - negotiated_version = Version} = State0) -> + #state{data_tag = Protocol} = State0) -> case next_tls_record(Data, State0) of {Record, State} -> - next_state(StateName, Record, State); + next_state(StateName, StateName, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State0), + handle_normal_shutdown(Alert, StateName, State0), {stop, normal, State0} end; -handle_info({CloseTag, Socket}, _StateName, +handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, - negotiated_version = Version, - socket_options = Opts, - user_application = {_Mon,Pid}, from = From, - role = Role} = State) -> + negotiated_version = Version} = State) -> %% Note that as of TLS 1.1, %% failure to properly close a connection no longer requires that a %% session not be resumed. This is a change from TLS 1.0 to conform @@ -962,8 +922,7 @@ handle_info({CloseTag, Socket}, _StateName, %%invalidate_session(Role, Host, Port, Session) ok end, - alert_user(Opts#socket_options.active, Pid, From, - ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Role), + handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), {stop, normal, State}; handle_info({ErrorTag, Socket, econnaborted}, StateName, @@ -972,26 +931,26 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, alert_user(User, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), {stop, normal, State}; -handle_info({ErrorTag, Socket, Reason}, _, - #state{socket = Socket, from = User, - role = Role, error_tag = ErrorTag} = State) -> +handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, + error_tag = ErrorTag} = State) -> Report = io_lib:format("SSL: Socket error: ~p ~n", [Reason]), error_logger:info_report(Report), - alert_user(User, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), {stop, normal, State}; handle_info({'DOWN', MonitorRef, _, _, _}, _, State = #state{user_application={MonitorRef,_Pid}}) -> {stop, normal, State}; +handle_info(allow_renegotiate, StateName, State) -> + {next_state, StateName, State#state{allow_renegotiate = true}, get_timeout(State)}; + handle_info(Msg, StateName, State) -> Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [Msg]), error_logger:info_report(Report), {next_state, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec terminate(reason(), state_name(), #state{}) -> term(). -%% %% Description:This function is called by a gen_fsm when it is about %% to terminate. It should be the opposite of Module:init/1 and do any %% necessary cleaning up. When it returns, the gen_fsm terminates with @@ -1022,8 +981,6 @@ terminate(Reason, _StateName, #state{transport_cb = Transport, Transport:close(Socket). %%-------------------------------------------------------------------- --spec code_change(term(), state_name(), #state{}, list()) -> {ok, state_name(), #state{}}. -%% %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- @@ -1033,7 +990,8 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = ssl_connection_sup:start_child([Role, Host, Port, Socket, @@ -1044,9 +1002,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, catch error:{badmatch, {error, _} = Error} -> Error + end; + +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = socket_control(Socket, Pid, CbModule), + ok = handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error end. ssl_init(SslOpts, Role) -> + + init_manager_name(SslOpts#ssl_options.erl_dist), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, @@ -1054,6 +1029,10 @@ ssl_init(SslOpts, Role) -> DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}. +init_manager_name(false) -> + put(ssl_manager, ssl_manager); +init_manager_name(true) -> + put(ssl_manager, ssl_manager_dist). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, @@ -1105,18 +1084,38 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> {ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle), [PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List, PKey =:= 'RSAPrivateKey' orelse - PKey =:= 'DSAPrivateKey'], - public_key:pem_entry_decode(PemEntry, Password) + PKey =:= 'DSAPrivateKey' orelse + PKey =:= 'PrivateKeyInfo' + ], + private_key(public_key:pem_entry_decode(PemEntry, Password)) catch Error:Reason -> handle_file_error(?LINE, Error, Reason, KeyFile, ekeyfile, erlang:get_stacktrace()) end; +%% First two clauses are for backwards compatibility init_private_key(_,{rsa, PrivateKey}, _, _,_) -> - public_key:der_decode('RSAPrivateKey', PrivateKey); + init_private_key('RSAPrivateKey', PrivateKey); init_private_key(_,{dsa, PrivateKey},_,_,_) -> - public_key:der_decode('DSAPrivateKey', PrivateKey). + init_private_key('DSAPrivateKey', PrivateKey); +init_private_key(_,{Asn1Type, PrivateKey},_,_,_) -> + private_key(init_private_key(Asn1Type, PrivateKey)). + +init_private_key(Asn1Type, PrivateKey) -> + public_key:der_decode(Asn1Type, PrivateKey). + +private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'rsaEncryption'}, + privateKey = Key}) -> + public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)); + +private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'}, + privateKey = Key}) -> + public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key)); +private_key(Key) -> + Key. -spec(handle_file_error(_,_,_,_,_,_) -> no_return()). handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> @@ -1177,7 +1176,7 @@ handle_peer_cert(PeerCert, PublicKeyInfo, Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, {Record, State} = next_record(State1), - next_state(certify, Record, State). + next_state(certify, certify, Record, State). certify_client(#state{client_certificate_requested = true, role = client, connection_states = ConnectionStates0, @@ -1219,8 +1218,7 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, ignore -> State; #alert{} = Alert -> - handle_own_alert(Alert, Version, certify, State) - + throw(Alert) end; verify_client_cert(#state{client_certificate_requested = false} = State) -> State. @@ -1252,7 +1250,7 @@ do_server_hello(Type, #state{negotiated_version = Version, ConnectionStates, tls_handshake_hashes = Hashes}, {Record, State} = next_record(State3), - next_state(abbreviated, Record, State); + next_state(hello, abbreviated, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State1), {stop, normal, State1} @@ -1272,7 +1270,7 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = next_record(State2#state{session = Session}), - next_state(certify, Record, State) + next_state(hello, certify, Record, State) catch #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0), @@ -1284,7 +1282,7 @@ handle_new_session(NewId, CipherSuite, Compression, #state{session = Session0} = cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = next_record(State0#state{session = Session}), - next_state(certify, Record, State). + next_state(hello, certify, Record, State). handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, negotiated_version = Version, @@ -1299,7 +1297,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, next_record(State0#state{ connection_states = ConnectionStates1, session = Session}), - next_state(abbreviated, Record, State); + next_state(hello, abbreviated, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0), {stop, normal, State0} @@ -1316,10 +1314,10 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = client_certificate_requested = false, tls_handshake_hashes = Hashes}, {Record, State} = next_record(State2), - next_state(cipher, Record, State) + next_state(certify, cipher, Record, State) catch - #alert{} = Alert -> - handle_own_alert(Alert, Version, client_certify_and_key_exchange, State0), + throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, certify, State0), {stop, normal, State0} end. @@ -1630,15 +1628,12 @@ encode_packet(Data, #socket_options{packet=Packet}) -> end. encode_size_packet(Bin, Size, Max) -> - Len = byte_size(Bin), + Len = erlang:byte_size(Bin), case Len > Max of true -> throw({error, {badarg, {packet_to_large, Len, Max}}}); false -> <<Len:Size, Bin/binary>> end. -encode_data(Data, Version, ConnectionStates, RenegotiateAt) -> - ssl_record:encode_data(Data, Version, ConnectionStates, RenegotiateAt). - decode_alerts(Bin) -> decode_alerts(Bin, []). @@ -1652,20 +1647,20 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> case Buffer of <<>> -> {Record, State} = next_record(State0), - next_state(StateName, Record, State); + next_state(StateName, StateName, Record, State); _ -> - case application_data(<<>>, State0) of + case read_application_data(<<>>, State0) of Stop = {stop, _, _} -> Stop; {Record, State} -> - next_state(StateName, Record, State) + next_state(StateName, StateName, Record, State) end end. -application_data(Data, #state{user_application = {_Mon, Pid}, +read_application_data(Data, #state{user_application = {_Mon, Pid}, socket_options = SOpts, bytes_to_read = BytesToRead, - from = From, + recv_from = From, user_data_buffer = Buffer0} = State0) -> Buffer1 = if Buffer0 =:= <<>> -> Data; @@ -1676,7 +1671,7 @@ application_data(Data, #state{user_application = {_Mon, Pid}, {ok, ClientData, Buffer} -> % Send data SocketOpt = deliver_app_data(SOpts, ClientData, Pid, From), State = State0#state{user_data_buffer = Buffer, - from = undefined, + recv_from = undefined, bytes_to_read = 0, socket_options = SocketOpt }, @@ -1686,7 +1681,7 @@ application_data(Data, #state{user_application = {_Mon, Pid}, %% Active and empty, get more data next_record_if_active(State); true -> %% We have more data - application_data(<<>>, State) + read_application_data(<<>>, State) end; {more, Buffer} -> % no reply, we need more data next_record(State0#state{user_data_buffer = Buffer}); @@ -1695,6 +1690,39 @@ application_data(Data, #state{user_application = {_Mon, Pid}, {stop, normal, State0} end. +write_application_data(Data0, From, #state{socket = Socket, + negotiated_version = Version, + transport_cb = Transport, + connection_states = ConnectionStates0, + send_queue = SendQueue, + socket_options = SockOpts, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) -> + Data = encode_packet(Data0, SockOpts), + + case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of + true -> + renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue), + renegotiation = {true, internal}}); + false -> + {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), + Result = Transport:send(Socket, Msgs), + {reply, Result, + connection, State#state{connection_states = ConnectionStates}, get_timeout(State)} + end. + +time_to_renegotiate(_Data, #connection_states{current_write = + #connection_state{sequence_number = Num}}, RenegotiateAt) -> + + %% We could do test: + %% is_time_to_renegotiate((erlang:byte_size(_Data) div ?MAX_PLAIN_TEXT_LENGTH) + 1, RenegotiateAt), + %% but we chose to have a some what lower renegotiateAt and a much cheaper test + is_time_to_renegotiate(Num, RenegotiateAt). + +is_time_to_renegotiate(N, M) when N < M-> + false; +is_time_to_renegotiate(_,_) -> + true. + %% Picks ClientData get_data(_, _, <<>>) -> {more, <<>>}; @@ -1778,7 +1806,8 @@ format_reply(binary, _, N, Data) when N > 0 -> % Header mode format_reply(binary, _, _, Data) -> Data; format_reply(list, Packet, _, Data) - when Packet == http; Packet == {http, headers}; Packet == http_bin; Packet == {http_bin, headers} -> + when Packet == http; Packet == {http, headers}; Packet == http_bin; Packet == {http_bin, headers}; Packet == httph; + Packet == httph_bin-> Data; format_reply(list, _,_, Data) -> binary_to_list(Data). @@ -1795,6 +1824,10 @@ header(N, Binary) -> send_or_reply(false, _Pid, From, Data) when From =/= undefined -> gen_fsm:reply(From, Data); +%% Can happen when handling own alert or tcp error/close and there is +%% no outstanding gen_fsm sync events +send_or_reply(false, no_pid, _, _) -> + ok; send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Data). @@ -1819,18 +1852,18 @@ handle_tls_handshake(Handle, StateName, #state{tls_packets = [Packet | Packets]} Stop end. -next_state(_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, decipher_error, State), +next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> + handle_own_alert(Alert, Version, Current, State), {stop, normal, State}; -next_state(Next, no_record, State) -> +next_state(_,Next, no_record, State) -> {next_state, Next, State, get_timeout(State)}; -next_state(Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> +next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> Alerts = decode_alerts(EncAlerts), handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); -next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, +next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, State0 = #state{tls_handshake_buffer = Buf0, negotiated_version = Version}) -> Handle = fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> @@ -1856,30 +1889,30 @@ next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, try {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0), State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf}, - handle_tls_handshake(Handle, StateName, State) + handle_tls_handshake(Handle, Next, State) catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State0), + handle_own_alert(Alert, Version, Current, State0), {stop, normal, State0} end; -next_state(StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> - case application_data(Data, State0) of +next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> + case read_application_data(Data, State0) of Stop = {stop,_,_} -> Stop; {Record, State} -> - next_state(StateName, Record, State) + next_state(StateName, StateName, Record, State) end; -next_state(StateName, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = +next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = _ChangeCipher, #state{connection_states = ConnectionStates0} = State0) -> ConnectionStates1 = ssl_record:activate_pending_connection_state(ConnectionStates0, read), {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), - next_state(StateName, Record, State); -next_state(StateName, #ssl_tls{type = _Unknown}, State0) -> + next_state(Current, Next, Record, State); +next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> %% Ignore unknown type {Record, State} = next_record(State0), - next_state(StateName, Record, State). + next_state(Current, Next, Record, State). next_tls_record(Data, #state{tls_record_buffer = Buf0, tls_cipher_texts = CT0} = State0) -> @@ -1918,63 +1951,49 @@ next_state_connection(StateName, #state{send_queue = Queue0, negotiated_version = Version, socket = Socket, transport_cb = Transport, - connection_states = ConnectionStates0, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt} + connection_states = ConnectionStates0 } = State) -> - %% Send queued up data + %% Send queued up data that was queued while renegotiating case queue:out(Queue0) of {{value, {From, Data}}, Queue} -> - case encode_data(Data, Version, ConnectionStates0, RenegotiateAt) of - {Msgs, [], ConnectionStates} -> - Result = Transport:send(Socket, Msgs), - gen_fsm:reply(From, Result), - next_state_connection(StateName, - State#state{connection_states = ConnectionStates, - send_queue = Queue}); - %% This is unlikely to happen. User configuration of the - %% undocumented test option renegotiation_at can make it more likely. - {Msgs, RestData, ConnectionStates} -> - if - Msgs =/= [] -> - Transport:send(Socket, Msgs); - true -> - ok - end, - renegotiate(State#state{connection_states = ConnectionStates, - send_queue = queue:in_r({From, RestData}, Queue), - renegotiation = {true, internal}}) - end; + {Msgs, ConnectionStates} = + ssl_record:encode_data(Data, Version, ConnectionStates0), + Result = Transport:send(Socket, Msgs), + gen_fsm:reply(From, Result), + next_state_connection(StateName, + State#state{connection_states = ConnectionStates, + send_queue = Queue}); {empty, Queue0} -> - next_state_is_connection(State) + next_state_is_connection(StateName, State) end. %% In next_state_is_connection/1: clear tls_handshake_hashes, %% premaster_secret and public_key_info (only needed during handshake) %% to reduce memory foot print of a connection. -next_state_is_connection(State = - #state{recv_during_renegotiation = true, socket_options = - #socket_options{active = false}}) -> - passive_receive(State#state{recv_during_renegotiation = false, - premaster_secret = undefined, +next_state_is_connection(_, State = + #state{recv_from = From, + socket_options = + #socket_options{active = false}}) when From =/= undefined -> + passive_receive(State#state{premaster_secret = undefined, public_key_info = undefined, tls_handshake_hashes = {<<>>, <<>>}}, connection); -next_state_is_connection(State0) -> +next_state_is_connection(StateName, State0) -> {Record, State} = next_record_if_active(State0), - next_state(connection, Record, State#state{premaster_secret = undefined, + next_state(StateName, connection, Record, State#state{premaster_secret = undefined, public_key_info = undefined, tls_handshake_hashes = {<<>>, <<>>}}). -register_session(_, _, _, #session{is_resumable = true} = Session) -> - Session; %% Already registered -register_session(client, Host, Port, Session0) -> +register_session(client, Host, Port, #session{is_resumable = new} = Session0) -> Session = Session0#session{is_resumable = true}, ssl_manager:register_session(Host, Port, Session), Session; -register_session(server, _, Port, Session0) -> +register_session(server, _, Port, #session{is_resumable = new} = Session0) -> Session = Session0#session{is_resumable = true}, ssl_manager:register_session(Port, Session), - Session. + Session; +register_session(_, _, _, Session) -> + Session. %% Already registered invalidate_session(client, Host, Port, Session) -> ssl_manager:invalidate_session(Host, Port, Session); @@ -1998,7 +2017,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, %% We do not want to save the password in the state so that %% could be written in the clear into error logs. ssl_options = SSLOptions#ssl_options{password = undefined}, - session = #session{is_resumable = false}, + session = #session{is_resumable = new}, transport_cb = CbModule, data_tag = DataTag, close_tag = CloseTag, @@ -2017,7 +2036,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, log_alert = true, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, - recv_during_renegotiation = false, + recv_from = undefined, send_queue = queue:new() }. @@ -2090,7 +2109,9 @@ set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet = Packet == tpkt; Packet == line; Packet == http; - Packet == http_bin -> + Packet == httph; + Packet == http_bin; + Packet == httph_bin -> set_socket_opts(Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); set_socket_opts(_, [{packet, _} = Opt| _], SockOpts, _) -> @@ -2128,16 +2149,14 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - StateName, #state{from = From, role = Role, - user_application = {_Mon, Pid}, socket_options = Opts} = State) -> - alert_user(StateName, Opts, Pid, From, Alert, Role), + StateName, State) -> + handle_normal_shutdown(Alert, StateName, State), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{log_alert = Log, renegotiation = {true, internal}, from = From, - role = Role} = State) -> + #state{log_alert = Log, renegotiation = {true, internal}} = State) -> log_alert(Log, StateName, Alert), - alert_user(From, Alert, Role), + handle_normal_shutdown(Alert, StateName, State), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, @@ -2145,13 +2164,13 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, log_alert(Log, StateName, Alert), gen_fsm:reply(From, {error, renegotiation_rejected}), {Record, State} = next_record(State0), - next_state(connection, Record, State); + next_state(StateName, connection, Record, State); handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName, #state{log_alert = Log} = State0) -> log_alert(Log, StateName, Alert), {Record, State} = next_record(State0), - next_state(StateName, Record, State). + next_state(StateName, StateName, Record, State). alert_user(connection, Opts, Pid, From, Alert, Role) -> alert_user(Opts#socket_options.active, Pid, From, Alert, Role); @@ -2183,13 +2202,11 @@ log_alert(true, Info, Alert) -> log_alert(false, _, _) -> ok. -handle_own_alert(Alert, Version, Info, +handle_own_alert(Alert, Version, StateName, #state{transport_cb = Transport, socket = Socket, - from = User, - role = Role, connection_states = ConnectionStates, - log_alert = Log}) -> + log_alert = Log} = State) -> try %% Try to tell the other side {BinMsg, _} = encode_alert(Alert, Version, ConnectionStates), @@ -2199,12 +2216,20 @@ handle_own_alert(Alert, Version, Info, ignore end, try %% Try to tell the local user - log_alert(Log, Info, Alert), - alert_user(User, Alert, Role) + log_alert(Log, StateName, Alert), + handle_normal_shutdown(Alert,StateName, State) catch _:_ -> ok end. +handle_normal_shutdown(Alert, _, #state{from = User, role = Role, renegotiation = {false, first}}) -> + alert_user(User, Alert, Role); + +handle_normal_shutdown(Alert, StateName, #state{socket_options = Opts, + user_application = {_Mon, Pid}, + from = User, role = Role}) -> + alert_user(StateName, Opts, Pid, User, Alert, Role). + handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), handle_own_alert(Alert, Version, {Info, Msg}, State), @@ -2217,7 +2242,7 @@ make_premaster_secret(_, _) -> undefined. mpint_binary(Binary) -> - Size = byte_size(Binary), + Size = erlang:byte_size(Binary), <<?UINT32(Size), Binary/binary>>. @@ -2254,7 +2279,7 @@ renegotiate(#state{role = server, {Record, State} = next_record(State0#state{connection_states = ConnectionStates, tls_handshake_hashes = Hs0}), - next_state(hello, Record, State). + next_state(connection, hello, Record, State#state{allow_renegotiate = true}). notify_senders(SendQueue) -> lists:foreach(fun({From, _}) -> diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl index e9328d5f7c..78cfda5e63 100644 --- a/lib/ssl/src/ssl_connection_sup.erl +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -26,8 +26,8 @@ -behaviour(supervisor). %% API --export([start_link/0]). --export([start_child/1]). +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). %% Supervisor callback -export([init/1]). @@ -38,9 +38,15 @@ start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +start_link_dist() -> + supervisor:start_link({local, ssl_connection_sup_dist}, ?MODULE, []). + start_child(Args) -> supervisor:start_child(?MODULE, Args). +start_child_dist(Args) -> + supervisor:start_child(ssl_connection_sup_dist, Args). + %%%========================================================================= %%% Supervisor callback %%%========================================================================= diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl new file mode 100644 index 0000000000..9d9afb7707 --- /dev/null +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -0,0 +1,83 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% + +%% + +-module(ssl_dist_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + SessionCertManager = session_and_cert_manager_child_spec(), + ConnetionManager = connection_manager_child_spec(), + ProxyServer = proxy_server_child_spec(), + + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ProxyServer]}}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +session_and_cert_manager_child_spec() -> + Opts = ssl_sup:manager_opts(), + Name = ssl_manager_dist, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +connection_manager_child_spec() -> + Name = ssl_connection_dist, + StartFunc = {ssl_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +proxy_server_child_spec() -> + Name = ssl_tls_dist_proxy, + StartFunc = {ssl_tls_dist_proxy, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_tls_dist_proxy], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 453ea20f99..542033e6ce 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. 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 @@ -39,6 +39,8 @@ encode_handshake/2, init_hashes/0, update_hashes/2, decrypt_premaster_secret/2]). +-export([dec_hello_extensions/2]). + -type tls_handshake() :: #client_hello{} | #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | #client_key_exchange{} | #finished{} | #certificate_verify{} | @@ -186,14 +188,14 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, ValidationFunAndState = case VerifyFunAndState of undefined -> - {fun(OtpCert, ExtensionOrError, SslState) -> + {fun(OtpCert, ExtensionOrVerifyResult, SslState) -> ssl_certificate:validate_extension(OtpCert, - ExtensionOrError, SslState) + ExtensionOrVerifyResult, SslState) end, Role}; {Fun, UserState0} -> - {fun(OtpCert, ExtensionOrError, {SslState, UserState}) -> + {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> case ssl_certificate:validate_extension(OtpCert, - ExtensionOrError, + Extension, SslState) of {valid, NewSslState} -> {valid, {NewSslState, UserState}}; @@ -202,8 +204,11 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, SslState); {unknown, _} -> apply_user_fun(Fun, OtpCert, - ExtensionOrError, UserState, SslState) - end + Extension, UserState, SslState) + end; + (OtpCert, VerifyResult, {SslState, UserState}) -> + apply_user_fun(Fun, OtpCert, VerifyResult, UserState, + SslState) end, {Role, UserState0}} end, @@ -445,7 +450,7 @@ server_hello_done() -> -spec encode_handshake(tls_handshake(), tls_version()) -> iolist(). %% %% Description: Encode a handshake packet to binary -%%-------------------------------------------------------------------- +%%--------------------------------------------------------------------x encode_handshake(Package, Version) -> {MsgType, Bin} = enc_hs(Package, Version), Len = byte_size(Bin), @@ -912,9 +917,12 @@ dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binar end, dec_hello_extensions(Rest, [{renegotiation_info, #renegotiation_info{renegotiated_connection = RenegotiateInfo}} | Acc]); -dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len, Rest/binary>>, Acc) -> + +%% Ignore data following the ClientHello (i.e., +%% extensions) if not understood. +dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> dec_hello_extensions(Rest, Acc); -%% Need this clause? +%% This theoretically should not happen if the protocol is followed, but if it does it is ignored. dec_hello_extensions(_, Acc) -> Acc. @@ -1087,18 +1095,12 @@ certificate_authorities(CertDbHandle, CertDbRef) -> list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). certificate_authorities_from_db(CertDbHandle, CertDbRef) -> - certificate_authorities_from_db(CertDbHandle, CertDbRef, no_candidate, []). - -certificate_authorities_from_db(CertDbHandle,CertDbRef, PrevKey, Acc) -> - case ssl_manager:issuer_candidate(PrevKey, CertDbHandle) of - no_more_candidates -> - lists:reverse(Acc); - {{CertDbRef, _, _} = Key, Cert} -> - certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, [Cert|Acc]); - {Key, _Cert} -> - %% skip certs not from this ssl connection - certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, Acc) - end. + ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef -> + [Cert | Acc]; + (_, Acc) -> + Acc + end, + ssl_certificate_db:foldl(ConnectionCerts, [], CertDbHandle). digitally_signed(Hash, #'RSAPrivateKey'{} = Key) -> public_key:encrypt_private(Hash, Key, diff --git a/lib/ssl/src/ssl_int.hrl b/lib/ssl/src/ssl_int.hrl deleted file mode 100644 index 3686deffce..0000000000 --- a/lib/ssl/src/ssl_int.hrl +++ /dev/null @@ -1,99 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. 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% -%% - -%% - -%% op codes commands are in capital and reply codes in lower case - --define(CONNECT, 1). --define(CONNECT_WAIT, 2). --define(CONNECT_REP, 3). --define(CONNECT_ERR, 4). - --define(TERMINATE, 5). --define(CLOSE, 6). - --define(LISTEN, 7). --define(LISTEN_REP, 8). --define(LISTEN_ERR, 9). - --define(TRANSPORT_ACCEPT, 10). --define(NOACCEPT, 11). --define(TRANSPORT_ACCEPT_REP, 12). --define(TRANSPORT_ACCEPT_ERR, 13). - --define(FROMNET_CLOSE, 14). - --define(CONNECT_SYNC_ERR, 15). --define(LISTEN_SYNC_ERR, 16). - --define(PROXY_PORT, 23). --define(PROXY_JOIN, 24). --define(PROXY_JOIN_REP, 25). --define(PROXY_JOIN_ERR, 26). - --define(SET_SOCK_OPT, 27). --define(IOCTL_OK, 28). --define(IOCTL_ERR, 29). - --define(GETPEERNAME, 30). --define(GETPEERNAME_REP, 31). --define(GETPEERNAME_ERR, 32). - --define(GETSOCKNAME, 33). --define(GETSOCKNAME_REP, 34). --define(GETSOCKNAME_ERR, 35). - --define(GETPEERCERT, 36). --define(GETPEERCERT_REP, 37). --define(GETPEERCERT_ERR, 38). - --define(GETVERSION, 39). --define(GETVERSION_REP, 40). - --define(SET_SEED, 41). - --define(GETCONNINFO, 42). --define(GETCONNINFO_REP, 43). --define(GETCONNINFO_ERR, 44). - --define(SSL_ACCEPT, 45). --define(SSL_ACCEPT_REP, 46). --define(SSL_ACCEPT_ERR, 47). - --define(DUMP_CMD, 48). --define(DEBUG_CMD, 49). --define(DEBUGMSG_CMD, 50). - -%% -------------- - --define(SSLv2, 1). --define(SSLv3, 2). --define(TLSv1, 4). - - -%% Set socket options codes 'SET_SOCK_OPT' --define(SET_TCP_NODELAY, 1). - --define(DEF_BACKLOG, 128). - --define(DEF_TIMEOUT, 10000). - --record(sslsocket, { fd = nil, pid = nil}). - diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 6bf1edc452..18cfcdcd68 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -24,6 +24,9 @@ -include_lib("public_key/include/public_key.hrl"). +%% Looks like it does for backwards compatibility reasons +-record(sslsocket, {fd = nil, pid = nil}). + -type reason() :: term(). -type reply() :: term(). -type msg() :: term(). @@ -98,10 +101,12 @@ renegotiate_at, secure_renegotiate, debug, - hibernate_after % undefined if not hibernating, + hibernate_after,% undefined if not hibernating, % or number of ms of inactivity % after which ssl_connection will % go into hibernation + %% This option should only be set to true by inet_tls_dist + erl_dist = false }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 725a085d1f..6389ff03f5 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,10 +27,10 @@ -include("ssl_internal.hrl"). %% Internal application API --export([start_link/1, +-export([start_link/1, start_link_dist/1, connection_init/2, cache_pem_file/2, - lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4, - server_session_id/4, + lookup_trusted_cert/4, + client_session_id/4, server_session_id/4, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -51,7 +51,7 @@ session_lifetime, certificate_db, session_validation_timer, - last_delay_timer %% Keep for testing purposes + last_delay_timer = {undefined, undefined}%% Keep for testing purposes }). -define('24H_in_msec', 8640000). @@ -66,10 +66,20 @@ %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. %% -%% Description: Starts the server +%% Description: Starts the ssl manager that takes care of sessions +%% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []). + gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(Opts) -> + gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(string()| {der, list()}, client | server) -> @@ -102,16 +112,7 @@ cache_pem_file(File, DbHandle) -> %% -------------------------------------------------------------------- lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> ssl_certificate_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). -%%-------------------------------------------------------------------- --spec issuer_candidate(cert_key() | no_candidate, term()) -> - {cert_key(), - {der_cert(), - #'OTPCertificate'{}}} | no_more_candidates. -%% -%% Description: Return next issuer candidate. -%%-------------------------------------------------------------------- -issuer_candidate(PrevCandidateKey, DbHandle) -> - ssl_certificate_db:issuer_candidate(PrevCandidateKey, DbHandle). + %%-------------------------------------------------------------------- -spec client_session_id(host(), inet:port_number(), #ssl_options{}, der_cert() | undefined) -> session_id(). @@ -166,7 +167,8 @@ invalidate_session(Port, Session) -> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Opts]) -> +init([Name, Opts]) -> + put(ssl_manager, Name), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = @@ -267,25 +269,16 @@ handle_cast({register_session, Port, Session}, CacheCb:update(Cache, {Port, NewSession#session.session_id}, NewSession), {noreply, State}; -%%% When a session is invalidated we need to wait a while before deleting -%%% it as there might be pending connections that rightfully needs to look -%%% up the session data but new connections should not get to use this session. handle_cast({invalidate_session, Host, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - CacheCb:update(Cache, {{Host, Port}, ID}, Session#session{is_resumable = false}), - TRef = - erlang:send_after(delay_time(), self(), {delayed_clean_session, {{Host, Port}, ID}}), - {noreply, State#state{last_delay_timer = TRef}}; + invalidate_session(Cache, CacheCb, {{Host, Port}, ID}, Session, State); handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - CacheCb:update(Cache, {Port, ID}, Session#session{is_resumable = false}), - TRef = - erlang:send_after(delay_time(), self(), {delayed_clean_session, {Port, ID}}), - {noreply, State#state{last_delay_timer = TRef}}; + invalidate_session(Cache, CacheCb, {Port, ID}, Session, State); handle_cast({recache_pem, File, LastWrite, Pid, From}, #state{certificate_db = [_, FileToRefDb, _]} = State0) -> @@ -309,7 +302,7 @@ handle_cast({recache_pem, File, LastWrite, Pid, From}, %% {stop, reason(), #state{}}. %% %% Description: Handling all non call/cast messages -%%-------------------------------------------------------------------- +%%------------------------------------------------------------------- handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache = Cache, session_lifetime = LifeTime @@ -376,10 +369,10 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%-------------------------------------------------------------------- call(Msg) -> - gen_server:call(?MODULE, {Msg, self()}, infinity). + gen_server:call(get(ssl_manager), {Msg, self()}, infinity). cast(Msg) -> - gen_server:cast(?MODULE, Msg). + gen_server:cast(get(ssl_manager), Msg). validate_session(Host, Port, Session, LifeTime) -> case ssl_session:valid_session(Session, LifeTime) of @@ -399,9 +392,10 @@ validate_session(Port, Session, LifeTime) -> start_session_validator(Cache, CacheCb, LifeTime) -> spawn_link(?MODULE, init_session_validator, - [[Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]). -init_session_validator([Cache, CacheCb, LifeTime]) -> +init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> + put(ssl_manager, SslManagerName), CacheCb:foldl(fun session_validation/2, LifeTime, Cache). @@ -432,3 +426,25 @@ delay_time() -> _ -> ?CLEAN_SESSION_DB end. + +invalidate_session(Cache, CacheCb, Key, Session, #state{last_delay_timer = LastTimer} = State) -> + case CacheCb:lookup(Cache, Key) of + undefined -> %% Session is already invalidated + {noreply, State}; + #session{is_resumable = new} -> + CacheCb:delete(Cache, Key), + {noreply, State}; + _ -> + %% When a registered session is invalidated we need to wait a while before deleting + %% it as there might be pending connections that rightfully needs to look + %% up the session data but new connections should not get to use this session. + CacheCb:update(Cache, Key, Session#session{is_resumable = false}), + TRef = + erlang:send_after(delay_time(), self(), {delayed_clean_session, Key}), + {noreply, State#state{last_delay_timer = last_delay_timer(Key, TRef, LastTimer)}} + end. + +last_delay_timer({{_,_},_}, TRef, {LastServer, _}) -> + {LastServer, TRef}; +last_delay_timer({_,_}, TRef, {_, LastClient}) -> + {TRef, LastClient}. diff --git a/lib/ssl/src/ssl_prim.erl b/lib/ssl/src/ssl_prim.erl deleted file mode 100644 index e3140a89d1..0000000000 --- a/lib/ssl/src/ssl_prim.erl +++ /dev/null @@ -1,173 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. 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% -%% - -%% - -%% Purpose: Primitive interface to SSL, without broker process (used by -%% SSL distribution). - --module(ssl_prim). - --export([listen/2, connect/3, accept/1, close/1, send/2, send/3, recv/2, recv/3, - getll/1, getstat/2, setopts/2, controlling_process/2, peername/1, - sockname/1, getif/1]). - --include("ssl_int.hrl"). --include("ssl_broker_int.hrl"). - -%-define(filter(Call), filter((catch Call))). --define(filter(Call), filter(Call)). - -listen(Port, Opts) -> - St = newstate(listener), - ?filter(ssl_broker:listen_prim(ssl_server_prim, self(), Port, nonactive(Opts), St)). - -connect(Address, Port, Opts) -> - St = newstate(connector), - ?filter(ssl_broker:connect_prim(ssl_server_prim, inet_tcp, self(), Address, - Port, nonactive(Opts), infinity, St)). - -accept(#st{} = ListenSt0) -> - case transport_accept(ListenSt0) of - {ok, ListenSt1} -> - ssl_accept(ListenSt0, ListenSt1); - Error -> - Error - end. - -transport_accept(#st{opts = ListenOpts, thissock = ListenSocket}) -> - NewSt = newstate(acceptor), - ListenFd = ListenSocket#sslsocket.fd, - ?filter(ssl_broker:transport_accept_prim(ssl_server_prim, ListenFd, - ListenOpts, infinity, NewSt)). - -ssl_accept(#st{opts = LOpts}, ListenSt1) -> - ?filter(ssl_broker:ssl_accept_prim(ssl_server_prim, gen_tcp, self(), - LOpts, infinity, ListenSt1)). - -close(#st{fd = Fd}) when is_integer(Fd) -> - ssl_server:close_prim(ssl_server_prim, Fd), - ok; -close(_) -> - ok. - -send(St, Data) -> - send(St, Data, []). - -send(#st{proxysock = Proxysock, status = open}, Data, Opts) -> - case inet_tcp:send(Proxysock, Data, Opts) of - ok -> - ok; - {error, _} -> - {error, closed} - end; -send(#st{}, _Data, _Opts) -> - {error, closed}. - -recv(St, Length) -> - recv(St, Length, infinity). - -recv(#st{proxysock = Proxysock, status = open}, Length, Tmo) -> - inet_tcp:recv(Proxysock, Length, Tmo); -recv(#st{}, _Length, _Tmo) -> - {error, closed}. - -getll(#st{proxysock = Proxysock, status = open}) -> - inet:getll(Proxysock); -getll(#st{}) -> - {error, closed}. - -getstat(#st{proxysock = Proxysock, status = open}, Opts) -> - inet:getstat(Proxysock, Opts); -getstat(#st{}, _Opts) -> - {error, closed}. - -setopts(#st{proxysock = Proxysock, status = open}, Opts) -> - case remove_supported(Opts) of - [] -> - inet:setopts(Proxysock, Opts); - _ -> - {error, enotsup} - end; -setopts(#st{}, _Opts) -> - {error, closed}. - - -controlling_process(#st{proxysock = Proxysock, status = open}, Pid) - when is_pid(Pid) -> - inet_tcp:controlling_process(Proxysock, Pid); -controlling_process(#st{}, Pid) when is_pid(Pid) -> - {error, closed}. - -peername(#st{fd = Fd, status = open}) -> - case ssl_server:peername_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -peername(#st{}) -> - {error, closed}. - -sockname(#st{fd = Fd, status = open}) -> - case ssl_server:sockname_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -sockname(#st{}) -> - {error, closed}. - -getif(#st{proxysock = Proxysock, status = open}) -> - inet:getif(Proxysock); -getif(#st{}) -> - {error, closed}. - -remove_supported([{active, _}|T]) -> - remove_supported(T); -remove_supported([{packet,_}|T]) -> - remove_supported(T); -remove_supported([{deliver,_}|T]) -> - remove_supported(T); -remove_supported([H|T]) -> - [H | remove_supported(T)]; -remove_supported([]) -> - []. - -filter(Result) -> - case Result of - {ok, _Sock,St} -> - {ok, St}; - {error, Reason, _St} -> - {error,Reason} - end. - -nonactive([{active,_}|T]) -> - nonactive(T); -nonactive([H|T]) -> - [H | nonactive(T)]; -nonactive([]) -> - [{active, false}]. - -newstate(Type) -> - #st{brokertype = Type, server = whereis(ssl_server_prim), - client = undefined, collector = undefined, debug = false}. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 72091fdd5f..830026c825 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -48,7 +48,7 @@ %% Encoding records -export([encode_handshake/3, encode_alert_record/3, - encode_change_cipher_spec/2, encode_data/4]). + encode_change_cipher_spec/2, encode_data/3]). %% Decoding -export([decode_cipher_text/2]). @@ -503,36 +503,18 @@ decode_cipher_text(CipherText, ConnnectionStates0) -> Alert end. %%-------------------------------------------------------------------- --spec encode_data(iolist(), tls_version(), #connection_states{}, integer()) -> - {iolist(), iolist(), #connection_states{}}. +-spec encode_data(binary(), tls_version(), #connection_states{}) -> + {iolist(), #connection_states{}}. %% %% Description: Encodes data to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_data(Frag, Version, ConnectionStates, RenegotiateAt) - when byte_size(Frag) < (?MAX_PLAIN_TEXT_LENGTH - 2048) -> - case encode_plain_text(?APPLICATION_DATA,Version,Frag,ConnectionStates, RenegotiateAt) of - {renegotiate, Data} -> - {[], Data, ConnectionStates}; - {Msg, CS} -> - {Msg, [], CS} - end; - -encode_data(Frag, Version, ConnectionStates, RenegotiateAt) when is_binary(Frag) -> - Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH - 2048), - encode_data(Data, Version, ConnectionStates, RenegotiateAt); - -encode_data(Data, Version, ConnectionStates0, RenegotiateAt) when is_list(Data) -> - {ConnectionStates, EncodedMsg, NotEncdedData} = - lists:foldl(fun(B, {CS0, Encoded, Rest}) -> - case encode_plain_text(?APPLICATION_DATA, - Version, B, CS0, RenegotiateAt) of - {renegotiate, NotEnc} -> - {CS0, Encoded, [NotEnc | Rest]}; - {Enc, CS1} -> - {CS1, [Enc | Encoded], Rest} - end - end, {ConnectionStates0, [], []}, Data), - {lists:reverse(EncodedMsg), lists:reverse(NotEncdedData), ConnectionStates}. +encode_data(Frag, Version, + #connection_states{current_write = #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). %%-------------------------------------------------------------------- -spec encode_handshake(iolist(), tls_version(), #connection_states{}) -> @@ -566,6 +548,14 @@ encode_change_cipher_spec(Version, ConnectionStates) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +encode_iolist(Type, Data, Version, ConnectionStates0) -> + {ConnectionStates, EncodedMsg} = + lists:foldl(fun(Text, {CS0, Encoded}) -> + {Enc, CS1} = encode_plain_text(Type, Version, Text, CS0), + {CS1, [Enc | Encoded]} + end, {ConnectionStates0, []}, Data), + {lists:reverse(EncodedMsg), ConnectionStates}. + highest_protocol_version() -> highest_protocol_version(supported_protocol_versions()). @@ -602,29 +592,23 @@ record_protocol_role(client) -> record_protocol_role(server) -> ?SERVER. -split_bin(Bin, ChunkSize) -> - split_bin(Bin, ChunkSize, []). +%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are not vulnerable to this attack. +split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA) when BCA =/= ?RC4 andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + do_split_bin(Rest, ChunkSize, [[FirstByte]]); +split_bin(Bin, ChunkSize, _, _) -> + do_split_bin(Bin, ChunkSize, []). -split_bin(<<>>, _, Acc) -> +do_split_bin(<<>>, _, Acc) -> lists:reverse(Acc); -split_bin(Bin, ChunkSize, Acc) -> +do_split_bin(Bin, ChunkSize, Acc) -> case Bin of <<Chunk:ChunkSize/binary, Rest/binary>> -> - split_bin(Rest, ChunkSize, [Chunk | Acc]); + do_split_bin(Rest, ChunkSize, [Chunk | Acc]); _ -> lists:reverse(Acc, [Bin]) end. -encode_plain_text(Type, Version, Data, ConnectionStates, RenegotiateAt) -> - #connection_states{current_write = - #connection_state{sequence_number = Num}} = ConnectionStates, - case renegotiate(Num, RenegotiateAt) of - false -> - encode_plain_text(Type, Version, Data, ConnectionStates); - true -> - {renegotiate, Data} - end. - encode_plain_text(Type, Version, Data, ConnectionStates) -> #connection_states{current_write=#connection_state{ compression_state=CompS0, @@ -637,11 +621,6 @@ encode_plain_text(Type, Version, Data, ConnectionStates) -> CTBin = encode_tls_cipher_text(Type, Version, CipherText), {CTBin, ConnectionStates#connection_states{current_write = CS2}}. -renegotiate(N, M) when N < M-> - false; -renegotiate(_,_) -> - true. - encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment) -> Length = erlang:iolist_size(Fragment), [<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment]. diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 5fb0070b91..282d642138 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -70,9 +70,10 @@ -define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19 %% Sequence numbers can not wrap so when max is about to be reached we should renegotiate. %% We will renegotiate a little before so that there will be sequence numbers left -%% for the rehandshake and a little data. --define(MARGIN, 100). --define(DEFAULT_RENEGOTIATE_AT, ?MAX_SEQENCE_NUMBER - ?MARGIN). +%% for the rehandshake and a little data. Currently we decided to renegotiate a little more +%% often as we can have a cheaper test to check if it is time to renegotiate. It will still +%% be fairly seldom. +-define(DEFAULT_RENEGOTIATE_AT, 268435456). %% math:pow(2, 28) %% ConnectionEnd -define(SERVER, 0). diff --git a/lib/ssl/src/ssl_server.erl b/lib/ssl/src/ssl_server.erl deleted file mode 100644 index b66e20a397..0000000000 --- a/lib/ssl/src/ssl_server.erl +++ /dev/null @@ -1,1378 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. 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% -%% - -%% - -%%% Purpose : SSL server - -%% -%% TODO -%% -%% XXX The ip option in listen is not general enough. It is assumed -%% to be a tuple, which is not always the case. - --module(ssl_server). --behaviour(gen_server). - -%% External exports --export([start_link/0]). - --export([transport_accept/2, transport_accept/3, ssl_accept/2, ssl_accept/3, - ciphers/0, connect/5, connect/6, - connection_info/1, close/1, listen/3, listen/4, peercert/1, - peername/1, proxy_join/2, seed/1, setnodelay/2, sockname/1, - version/0]). - --export([start_link_prim/0]). --export([ssl_accept_prim/4, transport_accept_prim/4, - connect_prim/7, close_prim/2, - listen_prim/5, proxy_join_prim/3, peername_prim/2, setnodelay_prim/3, - sockname_prim/2]). - --export([dump/0, dump/1]). --export([enable_debug/0, disable_debug/0, set_debug/1]). --export([enable_debugmsg/0, disable_debugmsg/0, set_debugmsg/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2]). - --include("ssl_int.hrl"). - --record(st, { - port = [], % port() of port program - progpid = [], % OS pid of port program - debug = false, % debug printout flag - cons = [], % All brokers except pending accepts - paccepts = [], % Pending accept brokers - proxylsport = [], % proxy listen socket port - intref = 0, % internal reference counter - compvsn = "", % ssl compile library version - libvsn = "", % ssl library version - ciphers = [] % available ciphers - }). - - -%% In all functions below IP is a four tuple, e.g. {192, 236, 52, 7}. -%% Port, Fd and ListenFd are integers; Flags is a string of characters. -%% -%% The prefixes F and L mean foreign and local, respectively. -%% Example: FIP (IP address for foreign end). - -%% -%% start_link() -> {ok, Pid} | {error, Reason} -%% -start_link() -> - gen_server:start_link({local, ssl_server}, ssl_server, [], []). - -start_link_prim() -> - gen_server:start_link({local, ssl_server_prim}, ssl_server, [], []). - -%% -%% transport_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -transport_accept(ListenFd, Flags) -> - transport_accept(ListenFd, Flags, infinity). -transport_accept(ListenFd, Flags, Timeout) -> - transport_accept_prim(ssl_server,ListenFd, Flags, Timeout). - -transport_accept_prim(ServerName, ListenFd, Flags, Timeout) -> - Req = {transport_accept, self(), ListenFd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ssl_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -ssl_accept(ListenFd, Flags) -> - ssl_accept(ListenFd, Flags, infinity). -ssl_accept(ListenFd, Flags, Timeout) -> - ssl_accept_prim(ssl_server, ListenFd, Flags, Timeout). - -ssl_accept_prim(ServerName, Fd, Flags, Timeout) -> - Req = {ssl_accept, Fd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ciphers() -> {ok, Ciphers} -%% -ciphers() -> - gen_server:call(ssl_server, ciphers, infinity). - -%% -%% close(Fd) -> ok -%% -close(Fd) -> - close_prim(ssl_server, Fd). -close_prim(ServerName, Fd) -> - gen_server:call(ServerName, {close, self(), Fd}, infinity), - ok. - -%% -%% connect(LIP, LPort, FIP, FPort, Flags) -> {ok, Fd, ProxyLFPort} | -%% {error, Reason} -%% -connect(LIP, LPort, FIP, FPort, Flags) -> - connect(LIP, LPort, FIP, FPort, Flags, infinity). -connect(LIP, LPort, FIP, FPort, Flags, Timeout) -> - connect_prim(ssl_server, LIP, LPort, FIP, FPort, Flags, Timeout). - -connect_prim(ServerName, LIP, LPort, FIP, FPort, Flags, Timeout) -> - Req = {connect, self(), LIP, LPort, FIP, FPort, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% connection_info(Fd) -> {ok, {Protocol, Cipher}} | {error, Reason} -%% -connection_info(Fd) -> - Req = {connection_info, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% listen(IP, LPort, Flags), -%% listen(IP, LPort, Flags, BackLog) -> {ok, ListenFd, LPort0} | -%% {error, Reason} -%% -listen(IP, LPort, Flags) -> - listen(IP, LPort, Flags, ?DEF_BACKLOG). -listen(IP, LPort, Flags, BackLog) -> - listen_prim(ssl_server, IP, LPort, Flags, BackLog). -listen_prim(ServerName, IP, LPort, Flags, BackLog) -> - Req = {listen, self(), IP, LPort, Flags, BackLog}, - gen_server:call(ServerName, Req, infinity). - -%% -%% peercert(Fd) -> {ok, Cert} | {error, Reason} -%% -peercert(Fd) -> - Req = {peercert, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% peername(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(Fd) -> - peername_prim(ssl_server, Fd). -peername_prim(ServerName, Fd) -> - Req = {peername, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% proxy_join(Fd, LPort) -> ok | {error, Reason} -%% -proxy_join(Fd, LPort) -> - proxy_join_prim(ssl_server, Fd, LPort). -proxy_join_prim(ServerName, Fd, LPort) -> - Req = {proxy_join, self(), Fd, LPort}, - gen_server:call(ServerName, Req, infinity). - -%% -%% seed(Data) -%% -seed(Data) -> - Req = {seed, Data}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% set_nodelay(Fd, Boolean) -%% -setnodelay(Fd, Boolean) -> - setnodelay_prim(ssl_server, Fd, Boolean). -setnodelay_prim(ServerName, Fd, Boolean) -> - Req = {setnodelay, self(), Fd, Boolean}, - gen_server:call(ServerName, Req, infinity). - -%% -%% sockname(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(Fd) -> - sockname_prim(ssl_server, Fd). -sockname_prim(ServerName, Fd) -> - Req = {sockname, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% version() -> {ok, {CompVsn, LibVsn}} -%% -version() -> - gen_server:call(ssl_server, version, infinity). - - -enable_debug() -> - set_debug(true). - -disable_debug() -> - set_debug(false). - -set_debug(Bool) -> - set_debug(Bool, infinity). - -set_debug(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debug, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -enable_debugmsg() -> - set_debugmsg(true). - -disable_debugmsg() -> - set_debugmsg(false). - -set_debugmsg(Bool) -> - set_debugmsg(Bool, infinity). - -set_debugmsg(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debugmsg, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -dump() -> - dump(infinity). - -dump(Timeout) -> - Req = {dump, self()}, - gen_server:call(ssl_server, Req, Timeout). - -%% -%% init -%% -init([]) -> - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - ProgDir = - case init:get_argument(ssl_portprogram_dir) of - {ok, [[D]]} -> - D; - _ -> - find_priv_bin() - end, - {Program, Flags} = mk_cmd_line("ssl_esock"), - Cmd = filename:join(ProgDir, Program) ++ " " ++ Flags, - debug1(Debug, " start, Cmd = ~s~n", [Cmd]), - case (catch open_port({spawn, Cmd}, [binary, {packet, 4}])) of - Port when is_port(Port) -> - process_flag(trap_exit, true), - receive - {Port, {data, Bin}} -> - {ProxyLLPort, ProgPid, CompVsn, LibVsn, Ciphers} = - decode_msg(Bin, [int16, int32, string, string, - string]), - debug1(Debug, "port program pid = ~w~n", - [ProgPid]), - {ok, #st{port = Port, - proxylsport = ProxyLLPort, - progpid = ProgPid, - debug = Debug, - compvsn = CompVsn, - libvsn = LibVsn, - ciphers = Ciphers}}; - {'EXIT', Port, Reason} -> - {stop, Reason} - end; - {'EXIT', Reason} -> - {stop, Reason} - end. - -%% -%% transport_accept -%% -handle_call({transport_accept, Broker, ListenFd, Flags}, From, St) -> - debug(St, "transport_accept: broker = ~w, listenfd = ~w~n", - [Broker, ListenFd]), - case get_by_fd(ListenFd, St#st.cons) of - {ok, {ListenFd, _, _}} -> - send_cmd(St#st.port, ?TRANSPORT_ACCEPT, [int32(ListenFd), Flags, 0]), - PAccepts = add({ListenFd, Broker, From}, St#st.paccepts), - %% - %% We reply when we get TRANSPORT_ACCEPT_REP or ASYNC_ACCEPT_ERR - %% - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% ssl_accept -%% -handle_call({ssl_accept, Fd, Flags}, From, St) -> - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} = _Rep -> - send_cmd(St#st.port, ?SSL_ACCEPT, [int32(Fd), Flags, 0]), - %% We reply when we get SSL_ACCEPT_REP or ASYNC_ACCEPT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(ciphers, From, St) -> - debug(St, "ciphers: from = ~w~n", [From]), - {reply, {ok, St#st.ciphers}, St}; - -%% -%% connect -%% -handle_call({connect, Broker, LIP, LPort, FIP, FPort, Flags}, From, St) -> - debug(St, "connect: broker = ~w, ip = ~w, " - "sport = ~w~n", [Broker, FIP, FPort]), - Port = St#st.port, - LIPStr = ip_to_string(LIP), - FIPStr = ip_to_string(FIP), - IntRef = new_intref(St), - send_cmd(Port, ?CONNECT, [int32(IntRef), - int16(LPort), LIPStr, 0, - int16(FPort), FIPStr, 0, - Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got CONNECT_SYNC_ERR, or CONNECT_WAIT - %% and CONNECT_REP, or CONNECT_ERR. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% connection_info -%% -handle_call({connection_info, Broker, Fd}, From, St) -> - debug(St, "connection_info: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETCONNINFO, [int32(Fd)]), - %% We reply when we get GETCONNINFO_REP or GETCONNINFO_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% close -%% -handle_call({close, Broker, Fd}, _From, St) -> - debug(St, "close: broker = ~w, fd = ~w~n", - [Broker, Fd]), - #st{port = Port, cons = Cons0, paccepts = PAccepts0} = St, - case delete_by_fd(Fd, Cons0) of - %% Must match Broker pid; fd may be reused already. - {ok, {Fd, Broker, _}, Cons} -> - send_cmd(Port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, PAccepts0) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts - lists:foreach(fun({_, _, AccFrom}) -> - gen_server:reply(AccFrom, - {error, closed}) - end, DelAccepts), - {reply, ok, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {reply, ok, St#st{cons = Cons}} - end; - _ -> - {reply, ok, St} - end; - -%% -%% listen -%% -handle_call({listen, Broker, IP, LPort, Flags, BackLog}, From, St) -> - debug(St, "listen: broker = ~w, IP = ~w, " - "sport = ~w~n", [Broker, IP, LPort]), - Port = St#st.port, - IPStr = ip_to_string(IP), - IntRef = new_intref(St), - send_cmd(Port, ?LISTEN, [int32(IntRef), int16(LPort), IPStr, 0, - int16(BackLog), Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got LISTEN_REP. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% peercert -%% -handle_call({peercert, Broker, Fd}, From, St) -> - debug(St, "peercert: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERCERT, [int32(Fd)]), - %% We reply when we get GETPEERCERT_REP or GETPEERCERT_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - - -%% -%% peername -%% -handle_call({peername, Broker, Fd}, From, St) -> - debug(St, "peername: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERNAME, [int32(Fd)]), - %% We reply when we get GETPEERNAME_REP or GETPEERNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% proxy join -%% -handle_call({proxy_join, Broker, Fd, LPort}, From, St) -> - debug(St, "proxy_join: broker = ~w, fd = ~w, " - "sport = ~w~n", [Broker, Fd, LPort]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?PROXY_JOIN, [int32(Fd), - int16(LPort)]), - %% We reply when we get PROXY_JOIN_REP, or PROXY_JOIN_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% seed -%% -handle_call({seed, Data}, _From, St) when is_binary(Data) -> - send_cmd(St#st.port, ?SET_SEED, [int32(byte_size(Data)), Data]), - {reply, ok, St}; - -handle_call({seed, Data}, From, St) -> - case catch list_to_binary(Data) of - {'EXIT', _} -> - {reply, {error, edata}, St}; - Bin -> - handle_call({seed, Bin}, From, St) - end; - -%% -%% setnodelay -%% -handle_call({setnodelay, Broker, Fd, Boolean}, From, St) -> - debug(St, "setnodelay: broker = ~w, fd = ~w, " - "boolean = ~w~n", [Broker, Fd, Boolean]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - Val = if Boolean == true -> 1; true -> 0 end, - send_cmd(St#st.port, ?SET_SOCK_OPT, - [int32(Fd), ?SET_TCP_NODELAY, Val]), - %% We reply when we get IOCTL_OK or IOCTL_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% sockname -%% -handle_call({sockname, Broker, Fd}, From, St) -> - debug(St, "sockname: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETSOCKNAME, [int32(Fd)]), - %% We reply when we get GETSOCKNAME_REP or GETSOCKNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(version, From, St) -> - debug(St, "version: from = ~w~n", [From]), - {reply, {ok, {St#st.compvsn, St#st.libvsn}}, St}; - -%% -%% dump -%% -handle_call({dump, Broker}, _From, St) -> - debug(St, "dump: broker = ~w", [Broker]), - Port = St#st.port, - send_cmd(Port, ?DUMP_CMD, []), - {reply, ok, St}; - -%% -%% set_debug -%% -handle_call({set_debug, Bool, Broker}, _From, St) -> - debug(St, "set_debug: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUG_CMD, [Value]), - {reply, ok, St}; - -%% -%% set_debugmsg -%% -handle_call({set_debugmsg, Bool, Broker}, _From, St) -> - debug(St, "set_debugmsg: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUGMSG_CMD, [Value]), - {reply, ok, St}; - -handle_call(Request, _From, St) -> - debug(St, "unexpected call: ~w~n", [Request]), - Reply = {error, {badcall, Request}}, - {reply, Reply, St}. - -%% -%% handle_cast(Msg, St) -%% - - -handle_cast(Msg, St) -> - debug(St, "unexpected cast: ~w~n", [Msg]), - {noreply, St}. - -%% -%% handle_info(Info, St) -%% - -%% Data from port -%% -handle_info({Port, {data, Bin}}, - #st{cons = StCons, paccepts = Paccepts, - port = Port, proxylsport = Proxylsport} = St) - when is_binary(Bin) -> - %% io:format("++++ ssl_server got from port: ~w~n", [Bin]), - <<OpCode:8, _/binary>> = Bin, - case OpCode of - %% - %% transport_accept - %% - ?TRANSPORT_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {ListenFd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "transport_accept_err: listenfd = ~w, " - "reason = ~w~n", [ListenFd, Reason]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, _, From}, PAccepts} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?TRANSPORT_ACCEPT_REP when byte_size(Bin) >= 9 -> - {ListenFd, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "transport_accept_rep: listenfd = ~w, " - "fd = ~w~n", [ListenFd, Fd]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, Broker, From}, PAccepts} -> - Reply = {ok, Fd, Proxylsport}, - gen_server:reply(From, Reply), - debug(St, "transport_accept_rep: From = ~w\n", [From]), - Cons = add({Fd, Broker, From}, StCons), - {noreply, St#st{cons = Cons, paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ssl_accept - %% - ?SSL_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ssl_accept_err: listenfd = ~w, " - "reason = ~w~n", [Fd, Reason]), - %% JC: remove this? - case delete_last_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?SSL_ACCEPT_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ssl_accept_rep: Fd = ~w\n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _ -> - {noreply, St} - end; - - %% - %% connect - %% - ?CONNECT_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_WAIT when byte_size(Bin) >= 9 -> - {IntRef, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "connect_wait: intref = ~w, " - "fd = ~w~n", [IntRef, Fd]), - case replace_fd_by_intref(IntRef, StCons, Fd) of - {ok, _, Cons} -> - %% We reply when we get CONNECT_REP or CONNECT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - %% We have a new Fd which must be closed - send_cmd(Port, ?CLOSE, int32(Fd)), - {noreply, St} - end; - ?CONNECT_REP when byte_size(Bin) >= 5 -> - %% after CONNECT_WAIT - Fd = decode_msg(Bin, [int32]), - debug(St, "connect_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Fd, Proxylsport}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - %% Fd not yet published - hence close ourselves - send_cmd(Port, ?CLOSE, int32(Fd)), - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% connection_info - %% - ?GETCONNINFO_REP when byte_size(Bin) >= 5 -> - {Fd, Protocol, Cipher} = decode_msg(Bin, [int32, string, string]), - debug(St, "connection_info_rep: fd = ~w, " - "protcol = ~p, ip = ~p~n", [Fd, Protocol, Cipher]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {protocol_name(Protocol), - Cipher}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETCONNINFO_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connection_info_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% listen - %% - ?LISTEN_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "listen_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?LISTEN_REP when byte_size(Bin) >= 11 -> - {IntRef, ListenFd, LPort} = decode_msg(Bin, [int32, int32, int16]), - debug(St, "listen_rep: intref = ~w, " - "listenfd = ~w, sport = ~w~n", [IntRef, ListenFd, LPort]), - case replace_fd_from_by_intref(IntRef, StCons, ListenFd, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, ListenFd, LPort}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% ListenFd has to be closed. - send_cmd(Port, ?CLOSE, int32(ListenFd)), - {noreply, St} - end; - - %% - %% proxy join - %% - ?PROXY_JOIN_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "proxy_join_rep: fd = ~w~n", - [Fd]), - case get_by_fd(Fd, StCons) of - {ok, {_, _, From}} -> - gen_server:reply(From, ok), - {noreply, St}; - _Other -> - %% Already closed - {noreply, St} - end; - ?PROXY_JOIN_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "proxy_join_rep: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - case Reason of - enoproxysocket -> - send_cmd(Port, ?CLOSE, int32(Fd)); - _ -> - ok - %% Must not close Fd since it is published - end, - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peername - %% - ?GETPEERNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getpeername_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeername_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ioctl - %% - ?IOCTL_OK when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ioctl_ok: fd = ~w~n", - [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?IOCTL_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ioctl_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% sockname - %% - ?GETSOCKNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getsockname_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETSOCKNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getsockname_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peercert - %% - ?GETPEERCERT_REP when byte_size(Bin) >= 5 -> - {Fd, Cert} = decode_msg(Bin, [int32, bin]), - debug(St, "getpeercert_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Cert}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERCERT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeercert_err: fd = ~w, reason = ~w~n", - [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end - end; - -%% -%% EXIT -%% -handle_info({'EXIT', Pid, Reason}, St) when is_pid(Pid) -> - debug(St, "exit pid = ~w, " - "reason = ~w~n", [Pid, Reason]), - case delete_by_pid(Pid, St#st.cons) of - {ok, {{intref, _}, Pid, _}, Cons} -> - {noreply, St#st{cons = Cons}}; - {ok, {Fd, Pid, _}, Cons} -> - send_cmd(St#st.port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, St#st.paccepts) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts. - lists:foreach(fun({_, _, From}) -> - gen_server:reply(From, - {error, closed}) - end, DelAccepts), - {noreply, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {noreply, St#st{cons = Cons}} - end; - _ -> - case delete_by_pid(Pid, St#st.paccepts) of - {ok, {ListenFd, _, _}, PAccepts} -> - %% decrement ref count in port program - send_cmd(St#st.port, ?NOACCEPT, int32(ListenFd)), - {noreply, St#st{paccepts = PAccepts}}; - _ -> - {noreply, St} - end - end; - -%% -%% 'badsig' means bad message to port. Port program is unaffected. -%% -handle_info({'EXIT', Port, badsig}, #st{port = Port} = St) -> - debug(St, "badsig!!!~n", []), - {noreply, St}; - -handle_info({'EXIT', Port, Reason}, #st{port = Port} = St) -> - {stop, Reason, St}; - -handle_info(Info, St) -> - debug(St, "unexpected info: ~w~n", [Info]), - {noreply, St}. - -%% -%% terminate(Reason, St) -> any -%% -terminate(_Reason, _St) -> - ok. - -%% -%% code_change(OldVsn, St, Extra) -> {ok, NSt} -%% -code_change(_OldVsn, St, _Extra) -> - {ok, St}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - -%% -%% Send binary command to sock -%% -send_cmd(Port, Cmd, Args) -> - Port ! {self(), {command, [Cmd| Args]}}. - -%% -%% add(Descr, Cons) -> NCons -%% -add(D, L) -> - [D| L]. - -%% -%% get_by_fd(Fd, Cons) -> {ok, Descr} | not_found -%% -get_by_fd(Fd, Cons) -> - get_by_pos(Fd, 1, Cons). - -%% -%% delete_by_fd(Fd, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_fd(Fd, Cons) -> - delete_by_pos(Fd, 1, Cons). - -%% -%% delete_all_by_fd(Fd, Cons) -> {ok, DelCons, RemCons} | not_found. -%% -delete_all_by_fd(Fd, Cons) -> - delete_all_by_pos(Fd, 1, Cons). - -%% -%% delete_by_intref(IntRef, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_intref(IntRef, Cons) -> - delete_by_pos({intref, IntRef}, 1, Cons). - -%% -%% delete_by_pid(Pid, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_pid(Pid, Cons) -> - delete_by_pos(Pid, 2, Cons). - -%% -%% delete_last_by_fd(Fd, Cons) -> {ok, OldDesc, NCons} | not_found -%% -delete_last_by_fd(Fd, Cons) -> - case dlbf(Fd, Cons) of - {X, L} -> - {ok, X, L}; - _Other -> - not_found - end. - -dlbf(Fd, [H]) -> - last_elem(Fd, H, []); -dlbf(Fd, [H|T]) -> - case dlbf(Fd, T) of - {X, L} -> - {X, [H|L]}; - L -> - last_elem(Fd, H, L) - end; -dlbf(_Fd, []) -> - []. - -last_elem(Fd, H, L) when element(1, H) == Fd -> - {H, L}; -last_elem(_, H, L) -> - [H|L]. - - -%% -%% replace_from_by_fd(Fd, Cons, From) -> {ok, OldDesc, NewList} | not_found -%% -replace_from_by_fd(Fd, Cons, From) -> - replace_posn_by_pos(Fd, 1, Cons, [{From, 3}]). - -%% -%% replace_fd_by_intref(IntRef, Cons, Fd) -> {ok, OldDesc, NewList} | not_f. -%% -replace_fd_by_intref(IntRef, Cons, Fd) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{Fd, 1}]). - -%% -%% replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> -%% {ok, OldDesc, NewList} | not_found -%% -replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{NFd, 1}, {From, 3}]). - - -%% -%% All *_by_pos functions -%% - -get_by_pos(Key, Pos, [H|_]) when element(Pos, H) == Key -> - {ok, H}; -get_by_pos(Key, Pos, [_|T]) -> - get_by_pos(Key, Pos, T); -get_by_pos(_, _, []) -> - not_found. - -delete_by_pos(Key, Pos, Cons) -> - case delete_by_pos1(Key, Pos, {not_found, Cons}) of - {not_found, _} -> - not_found; - {ODesc, NCons} -> - {ok, ODesc, NCons} - end. -delete_by_pos1(Key, Pos, {_R, [H|T]}) when element(Pos, H) == Key -> - {H, T}; -delete_by_pos1(Key, Pos, {R, [H|T]}) -> - {R0, T0} = delete_by_pos1(Key, Pos, {R, T}), - {R0, [H| T0]}; -delete_by_pos1(_, _, {R, []}) -> - {R, []}. - -delete_all_by_pos(Key, Pos, Cons) -> - case lists:foldl(fun(H, {Ds, Rs}) when element(Pos, H) == Key -> - {[H|Ds], Rs}; - (H, {Ds, Rs}) -> - {Ds, [H|Rs]} - end, {[], []}, Cons) of - {[], _} -> - not_found; - {DelCons, RemCons} -> - {ok, DelCons, RemCons} - end. - -replace_posn_by_pos(Key, Pos, Cons, Repls) -> - replace_posn_by_pos1(Key, Pos, Cons, Repls, []). - -replace_posn_by_pos1(Key, Pos, [H0| T], Repls, Acc) - when element(Pos, H0) =:= Key -> - H = lists:foldl(fun({Val, VPos}, Tuple) -> - setelement(VPos, Tuple, Val) - end, H0, Repls), - {ok, H0, lists:reverse(Acc, [H| T])}; -replace_posn_by_pos1(Key, Pos, [H|T], Repls, Acc) -> - replace_posn_by_pos1(Key, Pos, T, Repls, [H| Acc]); -replace_posn_by_pos1(_, _, [], _, _) -> - not_found. - -%% -%% Binary/integer conversions -%% -int16(I) -> - %%[(I bsr 8) band 255, I band 255]. - <<I:16>>. - -int32(I) -> - %% [(I bsr 24) band 255, - %% (I bsr 16) band 255, - %% (I bsr 8) band 255, - %% I band 255]. - <<I:32>>. - -%% decode_msg(Bin, Format) -> Tuple | integer() | atom() | string() | -%% list of binaries() -%% -%% Decode message from binary -%% Format = [spec()] -%% spec() = int16 | int32 | string | atom | bin | bins -%% -%% Notice: The first byte (op code) of the binary message is removed. -%% Notice: bins returns a *list* of binaries. -%% -decode_msg(<<_, Bin/binary>>, Format) -> - Dec = dec(Format, Bin), - case Dec of - [Dec1] -> Dec1; - _ -> list_to_tuple(Dec) - end. - -dec([], _) -> - []; -dec([int16| F], <<N:16, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([int32| F], <<N:32, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([string| F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [Cs| dec(F, Bin1)]; -dec([atom|F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [list_to_atom(Cs)| dec(F, Bin1)]; - -dec([bin|F], Bin) -> - {Bin1, Bin2} = dec_bin(Bin), - [Bin1| dec(F, Bin2)]. - -%% NOTE: This clause is not actually used yet. -%% dec([bins|F], <<N:32, Bin0/binary>>) -> -%% {Bins, Bin1} = dec_bins(N, Bin0), -%% [Bins| dec(F, Bin1)]. - -dec_string(Bin) -> - dec_string(Bin, []). - -dec_string(<<0, Bin/binary>>, RCs) -> - {lists:reverse(RCs), Bin}; -dec_string(<<C, Bin/binary>>, RCs) -> - dec_string(Bin, [C| RCs]). - -dec_bin(<<L:32, Bin0/binary>>) -> - <<Bin1:L/binary, Bin2/binary>> = Bin0, - {Bin1, Bin2}. - -%% dec_bins(N, Bin) -> -%% dec_bins(N, Bin, []). - -%% dec_bins(0, Bin, Acc) -> -%% {lists:reverse(Acc), Bin}; -%% dec_bins(N, Bin0, Acc) when N > 0 -> -%% {Bin1, Bin2} = dec_bin(Bin0), -%% dec_bins(N - 1, Bin2, [Bin1| Acc]). - -%% -%% new_intref -%% -new_intref(St) -> - (St#st.intref + 1) band 16#ffffffff. - -%% -%% {Program, Flags} = mk_cmd_line(DefaultProgram) -%% -mk_cmd_line(Default) -> - {port_program(Default), - lists:flatten([debug_flag(), " ", debug_port_flag(), " ", - debugdir_flag(), " ", - msgdebug_flag(), " ", proxylsport_flag(), " ", - proxybacklog_flag(), " ", ephemeral_rsa_flag(), " ", - ephemeral_dh_flag(), " ", - protocol_version_flag(), " "])}. - -port_program(Default) -> - case application:get_env(ssl, port_program) of - {ok, Program} when is_list(Program) -> - Program; - _Other -> - Default - end. - -%% -%% As this server may be started by the distribution, it is not safe to assume -%% a working code server, neither a working file server. -%% I try to utilize the most primitive interfaces available to determine -%% the directory of the port_program. -%% -find_priv_bin() -> - PrivDir = case (catch code:priv_dir(ssl)) of - {'EXIT', _} -> - %% Code server probably not startet yet - {ok, P} = erl_prim_loader:get_path(), - ModuleFile = atom_to_list(?MODULE) ++ extension(), - Pd = (catch lists:foldl - (fun(X,Acc) -> - M = filename:join([X, ModuleFile]), - %% The file server probably not started - %% either, has to use raw interface. - case file:raw_read_file_info(M) of - {ok,_} -> - %% Found our own module in the - %% path, lets bail out with - %% the priv_dir of this directory - Y = filename:split(X), - throw(filename:join - (lists:sublist - (Y,length(Y) - 1) - ++ ["priv"])); - _ -> - Acc - end - end, - false,P)), - case Pd of - false -> - exit(ssl_priv_dir_indeterminate); - _ -> - Pd - end; - Dir -> - Dir - end, - filename:join([PrivDir, "bin"]). - -extension() -> - %% erlang:info(machine) returns machine name as text in all uppercase - "." ++ string:to_lower(erlang:system_info(machine)). - -debug_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -debug_port_flag() -> - case os:getenv("ERL_SSL_DEBUGPORT") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -msgdebug_flag() -> - case os:getenv("ERL_SSL_MSGDEBUG") of - false -> - get_env(msgdebug, "-dm"); - _ -> - "-dm" - end. - -proxylsport_flag() -> - case application:get_env(ssl, proxylsport) of - {ok, PortNum} -> - "-pp " ++ integer_to_list(PortNum); - _Other -> - "" - end. - -proxybacklog_flag() -> - case application:get_env(ssl, proxylsbacklog) of - {ok, Size} -> - "-pb " ++ integer_to_list(Size); - _Other -> - "" - end. - -debugdir_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - case application:get_env(ssl, debugdir) of - {ok, Dir} when is_list(Dir) -> - "-dd " ++ Dir; - _Other -> - "" - end; - _ -> - "-dd ./" - end. - -ephemeral_rsa_flag() -> - case application:get_env(ssl, ephemeral_rsa) of - {ok, true} -> - "-ersa "; - _Other -> - "" - end. - -ephemeral_dh_flag() -> - case application:get_env(ssl, ephemeral_dh) of - {ok, true} -> - "-edh "; - _Other -> - "" - end. - -protocol_version_flag() -> - case application:get_env(ssl, protocol_version) of - {ok, []} -> - ""; - {ok, Vsns} when is_list(Vsns) -> - case transform_vsns(Vsns) of - N when (N > 0) -> - "-pv " ++ integer_to_list(N); - _ -> - "" - end; - _Other -> - "" - end. - -transform_vsns(Vsns) -> - transform_vsns(Vsns, 0). - -transform_vsns([sslv2| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv2); -transform_vsns([sslv3| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv3); -transform_vsns([tlsv1| Vsns], I) -> - transform_vsns(Vsns, I bor ?TLSv1); -transform_vsns([_ | Vsns], I) -> - transform_vsns(Vsns, I); -transform_vsns([], I) -> - I. - -protocol_name("SSLv2") -> sslv2; -protocol_name("SSLv3") -> sslv3; -protocol_name("TLSv1") -> tlsv1. - -get_env(Key, Val) -> - case application:get_env(ssl, Key) of - {ok, true} -> - Val; - _Other -> - "" - end. - -ip_to_string({A,B,C,D}) -> - [integer_to_list(A),$.,integer_to_list(B),$., - integer_to_list(C),$.,integer_to_list(D)]. - -debug(St, Format, Args) -> - debug1(St#st.debug, Format, Args). - -debug1(true, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_server (~w): " ++ Format0, - io:format(Format, [Secs, MiSecs, self()| Args]); -debug1(_, _, _) -> - ok. diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index bf738649f6..df5d7e0146 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -103,9 +103,9 @@ select_session([], _, _) -> select_session(Sessions, #ssl_options{ciphers = Ciphers, reuse_sessions = ReuseSession}, OwnCert) -> - IsResumable = - fun(Session) -> - ReuseSession andalso (Session#session.is_resumable) andalso + IsResumable = + fun(Session) -> + ReuseSession andalso resumable(Session#session.is_resumable) andalso lists:member(Session#session.cipher_suite, Ciphers) andalso (OwnCert == Session#session.own_certificate) end, @@ -147,10 +147,10 @@ is_resumable(SuggestedSessionId, Port, ReuseEnabled, ReuseFun, Cache, #session{cipher_suite = CipherSuite, own_certificate = SessionOwnCert, compression_method = Compression, - is_resumable = Is_resumable, + is_resumable = IsResumable, peer_certificate = PeerCert} = Session -> ReuseEnabled - andalso Is_resumable + andalso resumable(IsResumable) andalso (OwnCert == SessionOwnCert) andalso valid_session(Session, SecondLifeTime) andalso ReuseFun(SuggestedSessionId, PeerCert, @@ -158,3 +158,8 @@ is_resumable(SuggestedSessionId, Port, ReuseEnabled, ReuseFun, Cache, undefined -> false end. + +resumable(new) -> + false; +resumable(IsResumable) -> + IsResumable. diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 93969f628f..f9bbf905e1 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.erl @@ -28,27 +28,19 @@ -export([init/1, terminate/1, lookup/2, update/3, delete/2, foldl/3, select_session/2]). --type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. - %%-------------------------------------------------------------------- --spec init(list()) -> db_handle(). %% Returns reference to the cache (opaque) -%% %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- init(_) -> ets:new(cache_name(), [set, protected]). %%-------------------------------------------------------------------- --spec terminate(db_handle()) -> any(). -%% %% Description: Handles cache table at termination of ssl manager. %%-------------------------------------------------------------------- terminate(Cache) -> ets:delete(Cache). %%-------------------------------------------------------------------- --spec lookup(db_handle(), key()) -> #session{} | undefined. -%% %% Description: Looks up a cach entry. Should be callable from any %% process. %%-------------------------------------------------------------------- @@ -61,8 +53,6 @@ lookup(Cache, Key) -> end. %%-------------------------------------------------------------------- --spec update(db_handle(), key(), #session{}) -> any(). -%% %% Description: Caches a new session or updates a already cached one. %% Will only be called from the ssl_manager process. %%-------------------------------------------------------------------- @@ -70,8 +60,6 @@ update(Cache, Key, Session) -> ets:insert(Cache, {Key, Session}). %%-------------------------------------------------------------------- --spec delete(db_handle(), key()) -> any(). -%% %% Description: Delets a cache entry. %% Will only be called from the ssl_manager process. %%-------------------------------------------------------------------- @@ -79,8 +67,6 @@ delete(Cache, Key) -> ets:delete(Cache, Key). %%-------------------------------------------------------------------- --spec foldl(fun(), term(), db_handle()) -> term(). -%% %% Description: Calls Fun(Elem, AccIn) on successive elements of the %% cache, starting with AccIn == Acc0. Fun/2 must return a new %% accumulator which is passed to the next call. The function returns @@ -91,8 +77,6 @@ foldl(Fun, Acc0, Cache) -> ets:foldl(Fun, Acc0, Cache). %%-------------------------------------------------------------------- --spec select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. -%% %% Description: Selects a session that could be reused. Should be callable %% from any process. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_session_cache_api.erl b/lib/ssl/src/ssl_session_cache_api.erl index f8416bf327..f2b22b0f1b 100644 --- a/lib/ssl/src/ssl_session_cache_api.erl +++ b/lib/ssl/src/ssl_session_cache_api.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -20,18 +20,15 @@ %% -module(ssl_session_cache_api). +-include("ssl_handshake.hrl"). +-include("ssl_internal.hrl"). --export([behaviour_info/1]). +-type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. -behaviour_info(callbacks) -> - [ - {init, 1}, - {terminate, 1}, - {lookup, 2}, - {update, 3}, - {delete, 2}, - {foldl, 3}, - {select_session, 2} - ]; -behaviour_info(_) -> - undefined. +-callback init(list()) -> db_handle(). +-callback terminate(db_handle()) -> any(). +-callback lookup(db_handle(), key()) -> #session{} | undefined. +-callback update(db_handle(), key(), #session{}) -> any(). +-callback delete(db_handle(), key()) -> any(). +-callback foldl(fun(), term(), db_handle()) -> term(). +-callback select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. diff --git a/lib/ssl/src/ssl_ssl2.erl b/lib/ssl/src/ssl_ssl2.erl index 30a3a5fc98..a9ab6a2678 100644 --- a/lib/ssl/src/ssl_ssl2.erl +++ b/lib/ssl/src/ssl_ssl2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 316ed8a4e9..59039a6e0a 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -24,7 +24,7 @@ -behaviour(supervisor). %% API --export([start_link/0]). +-export([start_link/0, manager_opts/0]). %% Supervisor callback -export([init/1]). @@ -41,7 +41,6 @@ start_link() -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. init([]) -> %% OLD ssl - moved start to ssl.erl only if old @@ -51,17 +50,32 @@ init([]) -> %% Does not start any port programs so it does matter %% so much if it is not used! - Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, - permanent, 2000, supervisor, [ssl_broker_sup]}, + %% Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, + %% permanent, 2000, supervisor, [ssl_broker_sup]}, %% New ssl SessionCertManager = session_and_cert_manager_child_spec(), ConnetionManager = connection_manager_child_spec(), - {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager, - ConnetionManager]}}. + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -86,21 +100,6 @@ connection_manager_child_spec() -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl new file mode 100644 index 0000000000..1c61eb7ccc --- /dev/null +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -0,0 +1,329 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% +-module(ssl_tls_dist_proxy). + + +-export([listen/1, accept/1, connect/2, get_tcp_address/1]). +-export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3, ssl_options/2]). + +-include_lib("kernel/include/net_address.hrl"). + +-record(state, + {listen, + accept_loop + }). + +-define(PPRE, 4). +-define(PPOST, 4). + + +%%==================================================================== +%% Internal application API +%%==================================================================== + +listen(Name) -> + gen_server:call(?MODULE, {listen, Name}, infinity). + +accept(Listen) -> + gen_server:call(?MODULE, {accept, Listen}, infinity). + +connect(Ip, Port) -> + gen_server:call(?MODULE, {connect, Ip, Port}, infinity). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init([]) -> + process_flag(priority, max), + {ok, #state{}}. + +handle_call({listen, Name}, _From, State) -> + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + {ok, Socket} -> + {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), + {ok, TcpAddress} = get_tcp_address(Socket), + {ok, WorldTcpAddress} = get_tcp_address(World), + {_,Port} = WorldTcpAddress#net_address.address, + {ok, Creation} = erl_epmd:register_node(Name, Port), + {reply, {ok, {Socket, TcpAddress, Creation}}, + State#state{listen={Socket, World}}}; + Error -> + {reply, Error, State} + end; + +handle_call({accept, Listen}, {From, _}, State = #state{listen={_, World}}) -> + Self = self(), + ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end), + WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end), + {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}}; + +handle_call({connect, Ip, Port}, {From, _}, State) -> + Me = self(), + Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end), + receive + {Pid, go_ahead, LPort} -> + Res = {ok, Socket} = try_connect(LPort), + case gen_tcp:controlling_process(Socket, From) of + {error, badarg} = Error -> {reply, Error, State}; % From is dead anyway. + ok -> + flush_old_controller(From, Socket), + {reply, Res, State} + end; + {Pid, Error} -> + {reply, Error, State} + end; + +handle_call(_What, _From, State) -> + {reply, ok, State}. + +handle_cast(_What, State) -> + {noreply, State}. + +handle_info(_What, State) -> + {noreply, State}. + +terminate(_Reason, _St) -> + ok. + +code_change(_OldVsn, St, _Extra) -> + {ok, St}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +get_tcp_address(Socket) -> + case inet:sockname(Socket) of + {ok, Address} -> + {ok, Host} = inet:gethostname(), + NetAddress = #net_address{ + address = Address, + host = Host, + protocol = proxy, + family = inet + }, + {ok, NetAddress}; + {error, _} = Error -> Error + end. + +accept_loop(Proxy, erts = Type, Listen, Extra) -> + process_flag(priority, max), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Extra ! {accept,self(),Socket,inet,proxy}, + receive + {_Kernel, controller, Pid} -> + ok = gen_tcp:controlling_process(Socket, Pid), + flush_old_controller(Pid, Socket), + Pid ! {self(), controller}; + {_Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end; + Error -> + exit(Error) + end, + accept_loop(Proxy, Type, Listen, Extra); + +accept_loop(Proxy, world = Type, Listen, Extra) -> + process_flag(priority, max), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + case ssl:ssl_accept(Socket, Opts) of + {ok, SslSocket} -> + PairHandler = + spawn_link(fun() -> + setup_connection(SslSocket, Extra) + end), + ok = ssl:controlling_process(SslSocket, PairHandler), + flush_old_controller(PairHandler, SslSocket); + _ -> + gen_tcp:close(Socket) + end; + Error -> + exit(Error) + end, + accept_loop(Proxy, Type, Listen, Extra). + +try_connect(Port) -> + case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of + R = {ok, _S} -> + R; + {error, _R} -> + try_connect(Port) + end. + +setup_proxy(Ip, Port, Parent) -> + process_flag(trap_exit, true), + Opts = get_ssl_options(client), + case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of + {ok, World} -> + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), + Parent ! {self(), go_ahead, LPort}, + case gen_tcp:accept(ErtsL) of + {ok, Erts} -> + %% gen_tcp:close(ErtsL), + loop_conn_setup(World, Erts); + Err -> + Parent ! {self(), Err} + end; + Err -> + Parent ! {self(), Err} + end. + +setup_connection(World, ErtsListen) -> + process_flag(trap_exit, true), + {ok, TcpAddress} = get_tcp_address(ErtsListen), + {_Addr,Port} = TcpAddress#net_address.address, + {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]), + ssl:setopts(World, [{active,true}, {packet,?PPRE}]), + loop_conn_setup(World, Erts). + +loop_conn_setup(World, Erts) -> + receive + {ssl, World, Data = <<$a, _/binary>>} -> + gen_tcp:send(Erts, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {tcp, Erts, Data = <<$a, _/binary>>} -> + ssl:send(World, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {ssl, World, Data = <<_, _/binary>>} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data = <<_, _/binary>>} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts); + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) + end. + +loop_conn(World, Erts) -> + receive + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) + end. + +get_ssl_options(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; + _ -> + [{erl_dist, true}] + end. + +ssl_options(_,[]) -> + []; +ssl_options(server, ["client_" ++ _, _Value |T]) -> + ssl_options(server,T); +ssl_options(client, ["server_" ++ _, _Value|T]) -> + ssl_options(client,T); +ssl_options(server, ["server_certfile", Value|T]) -> + [{certfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_certfile", Value | T]) -> + [{certfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_password", Value|T]) -> + [{password, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_password", Value|T]) -> + [{password, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_dhfile", Value|T]) -> + [{dhfile, Value} | ssl_options(server,T)]; +ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> + [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; +ssl_options(_,_) -> + exit(malformed_ssl_dist_opt). + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +flush_old_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_old_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_old_controller(Pid, Socket); + {ssl, Socket, Data} -> + Pid ! {ssl, Socket, Data}, + flush_old_controller(Pid, Socket); + {ssl_closed, Socket} -> + Pid ! {ssl_closed, Socket}, + flush_old_controller(Pid, Socket) + after 0 -> + ok + end. |