diff options
Diffstat (limited to 'lib/ssl/src')
26 files changed, 1210 insertions, 3972 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..115527aae0 --- /dev/null +++ b/lib/ssl/src/inet_tls_dist.erl @@ -0,0 +1,275 @@ +%% +%% %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(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end). + +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(S, N) -> + ssl_tls_dist_proxy:get_remote_id(S, N) + end + }). + +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}. 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 d3e426f254..29674f30da 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,17 +1,21 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.5", [{restart_application, ssl}]}, + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, - {"4.1", [{restart_application, ssl}]}, + {"4.1", [{restart_application, ssl}]}, {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.5", [{restart_application, ssl}]}, + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, - {"4.1", [{restart_application, ssl}]}, + {"4.1", [{restart_application, ssl}]}, {"4.0.1", [{restart_application, ssl}]} ]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 7b1fda4cf9..35f9410562 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"). @@ -49,10 +46,12 @@ inet_ssl, %% inet options for internal ssl socket cb %% Callback info }). --type option() :: socketoption() | ssloption() | transportoption(). --type socketoption() :: [{property(), term()}]. %% See gen_tcp and inet --type property() :: atom(). --type ssloption() :: {verify, verify_type()} | +-type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). +-type socket_connect_option() :: gen_tcp:connect_option(). +-type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). +-type socket_listen_option() :: gen_tcp:listen_option(). + +-type ssl_option() :: {verify, verify_type()} | {verify_fun, {fun(), InitialUserState::term()}} | {fail_if_no_peer_cert, boolean()} | {depth, integer()} | {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | @@ -67,7 +66,7 @@ string(). % (according to old API) -type ssl_imp() :: new | old. --type transportoption() :: {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}}. %%-------------------------------------------------------------------- @@ -97,15 +96,15 @@ stop() -> application:stop(ssl). %%-------------------------------------------------------------------- --spec connect(host() | port(), [option()]) -> {ok, #sslsocket{}} | +-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), [option()] | port_num(), timeout() | list()) -> +-spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), port_num(), list(), timeout()) -> +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Connect to a ssl server. +%% Description: Connect to an ssl server. %%-------------------------------------------------------------------- connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). @@ -113,7 +112,7 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - inet:setopts(Socket, internal_inet_values()), + ok = inet:setopts(Socket, internal_inet_values()), try handle_options(SslOptions0 ++ InetValues, client) of {ok, #config{cb=CbInfo, ssl=SslOptions, emulated=EmOpts}} -> case inet:peername(Socket) of @@ -132,59 +131,49 @@ 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. %%-------------------------------------------------------------------- --spec listen(port_num(), [option()]) ->{ok, #sslsocket{}} | {error, reason()}. +-spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Creates a ssl listen socket. +%% Description: Creates an ssl listen socket. %%-------------------------------------------------------------------- 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()}. -spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs transport accept on a ssl listen socket +%% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- 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. @@ -206,40 +195,30 @@ 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()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [option()]) -> +-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() | transport_option()]) -> ok | {ok, #sslsocket{}} | {error, reason()}. --spec ssl_accept(port(), [option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs accept on a ssl listen socket. e.i. performs +%% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- 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(), {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - inet:setopts(Socket, internal_inet_values()), + ok = inet:setopts(Socket, internal_inet_values()), try handle_options(SslOptions ++ InetValues, server) of {ok, #config{cb=CbInfo,ssl=SslOpts, emulated=EmOpts}} -> {ok, Port} = inet:port(Socket), @@ -253,27 +232,20 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %%-------------------------------------------------------------------- -spec close(#sslsocket{}) -> term(). %% -%% Description: Close a ssl connection +%% 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{}, iolist()) -> ok | {error, reason()}. +-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()}. @@ -284,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()}. @@ -296,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()}} | @@ -310,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, {tuple(), port_num()}} | {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()]. @@ -403,67 +315,74 @@ cipher_suites(openssl) -> [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]. %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}. +-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> + {ok, [gen_tcp:option()]} | {error, reason()}. %% -%% Description: -%%-------------------------------------------------------------------- -getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptTags) when is_pid(Pid) -> - ssl_connection:get_opts(Pid, OptTags); -getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptTags) -> - inet:getopts(ListenSocket, OptTags); -getopts(#sslsocket{} = Socket, Options) -> - ensure_old_ssl_started(), - ssl_broker:getopts(Socket, Options). +%% Description: Gets options +%%-------------------------------------------------------------------- +getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> + ssl_connection:get_opts(Pid, OptionTags); +getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> + try inet:getopts(ListenSocket, OptionTags) of + {ok, _} = Result -> + Result; + {error, InetError} -> + {error, {eoptions, {inet_options, OptionTags, InetError}}} + catch + _:_ -> + {error, {eoptions, {inet_options, OptionTags}}} + end; +getopts(#sslsocket{}, OptionTags) -> + {error, {eoptions, {inet_options, OptionTags}}}. %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [{atom(), term()}]) -> ok | {error, reason()}. +-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. %% -%% Description: +%% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{fd = new_ssl, pid = Pid}, Opts0) when is_pid(Pid) -> - Opts = proplists:expand([{binary, [{mode, binary}]}, - {list, [{mode, list}]}], Opts0), - ssl_connection:set_opts(Pid, Opts); -setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptTags) -> - inet:setopts(ListenSocket, OptTags); -setopts(#sslsocket{} = Socket, Options) -> - ensure_old_ssl_started(), - ssl_broker:setopts(Socket, Options). +setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> + try proplists:expand([{binary, [{mode, binary}]}, + {list, [{mode, list}]}], Options0) of + Options -> + ssl_connection:set_opts(Pid, Options) + catch + _:_ -> + {error, {eoptions, {not_a_proplist, Options0}}} + end; + +setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> + try inet:setopts(ListenSocket, Options) of + ok -> + ok; + {error, InetError} -> + {error, {eoptions, {inet_options, Options, InetError}}} + catch + _:Error -> + {error, {eoptions, {inet_options, Options, Error}}} + end; +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). %%-------------------------------------------------------------------- --spec sockname(#sslsocket{}) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% 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()}. @@ -519,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" ++ _ -> @@ -589,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) -> @@ -612,39 +465,15 @@ do_new_connect(Address, Port, catch exit:{function_clause, _} -> {error, {eoptions, {cb_info, CbInfo}}}; + exit:badarg -> + {error, {eoptions, {inet_options, UserOpts}}}; exit:{badarg, _} -> - {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 + {error, {eoptions, {inet_options, UserOpts}}} 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 = @@ -711,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}), @@ -720,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) @@ -737,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; @@ -831,6 +659,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}}}). @@ -878,7 +709,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{ @@ -939,47 +769,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_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 8c0c2bfa5d..422ea6404b 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.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 @@ -30,9 +30,9 @@ -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([trusted_cert_and_path/2, - certificate_chain/2, - file_to_certificats/1, +-export([trusted_cert_and_path/3, + certificate_chain/3, + file_to_certificats/2, validate_extension/3, is_valid_extkey_usage/2, is_valid_key_usage/2, @@ -46,14 +46,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec trusted_cert_and_path([der_cert()], certdb_ref()) -> +-spec trusted_cert_and_path([der_cert()], db_handle(), certdb_ref()) -> {der_cert() | unknown_ca, [der_cert()]}. %% %% Description: Extracts the root cert (if not presents tries to %% look it up, if not found {bad_cert, unknown_ca} will be added verification %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- -trusted_cert_and_path(CertChain, CertDbRef) -> +trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef) -> Path = [Cert | _] = lists:reverse(CertChain), OtpCert = public_key:pkix_decode_cert(Cert, otp), SignedAndIssuerID = @@ -66,7 +66,7 @@ trusted_cert_and_path(CertChain, CertDbRef) -> {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, no_candidate) of + case find_issuer(OtpCert, no_candidate, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> @@ -82,7 +82,7 @@ trusted_cert_and_path(CertChain, CertDbRef) -> {self, _} when length(Path) == 1 -> {selfsigned_peer, Path}; {_ ,{SerialNr, Issuer}} -> - case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of + case ssl_manager:lookup_trusted_cert(CertDbHandle, CertDbRef, SerialNr, Issuer) of {ok, {BinCert,_}} -> {BinCert, Path}; _ -> @@ -92,23 +92,23 @@ trusted_cert_and_path(CertChain, CertDbRef) -> end. %%-------------------------------------------------------------------- --spec certificate_chain(undefined | binary(), certdb_ref()) -> +-spec certificate_chain(undefined | binary(), db_handle(), certdb_ref()) -> {error, no_cert} | {ok, [der_cert()]}. %% %% Description: Return the certificate chain to send to peer. %%-------------------------------------------------------------------- -certificate_chain(undefined, _CertsDbRef) -> +certificate_chain(undefined, _, _) -> {error, no_cert}; -certificate_chain(OwnCert, CertsDbRef) -> +certificate_chain(OwnCert, CertDbHandle, CertsDbRef) -> ErlCert = public_key:pkix_decode_cert(OwnCert, otp), - certificate_chain(ErlCert, OwnCert, CertsDbRef, [OwnCert]). + certificate_chain(ErlCert, OwnCert, CertDbHandle, CertsDbRef, [OwnCert]). %%-------------------------------------------------------------------- --spec file_to_certificats(string()) -> [der_cert()]. +-spec file_to_certificats(string(), term()) -> [der_cert()]. %% %% Description: Return list of DER encoded certificates. %%-------------------------------------------------------------------- -file_to_certificats(File) -> - {ok, List} = ssl_manager:cache_pem_file(File), +file_to_certificats(File, DbHandle) -> + {ok, List} = ssl_manager:cache_pem_file(File, DbHandle), [Bin || {'Certificate', Bin, not_encrypted} <- List]. %%-------------------------------------------------------------------- -spec validate_extension(term(), #'Extension'{} | {bad_cert, atom()} | valid, @@ -180,7 +180,7 @@ signature_type(?'id-dsa-with-sha1') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> +certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -191,11 +191,11 @@ certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> case IssuerAndSelfSigned of {_, true = SelfSigned} -> - certificate_chain(CertsDbRef, Chain, ignore, ignore, SelfSigned); + certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, no_candidate) of + case find_issuer(OtpCert, no_candidate, CertDbHandle) of {ok, {SerialNr, Issuer}} -> - certificate_chain(CertsDbRef, Chain, + certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); _ -> %% Guess the the issuer must be the root @@ -205,19 +205,19 @@ certificate_chain(OtpCert, _Cert, CertsDbRef, Chain) -> {ok, lists:reverse(Chain)} end; {{ok, {SerialNr, Issuer}}, SelfSigned} -> - certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, SelfSigned) + certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned) end. -certificate_chain(_CertsDbRef, Chain, _SerialNr, _Issuer, true) -> +certificate_chain(_,_, Chain, _SerialNr, _Issuer, true) -> {ok, lists:reverse(Chain)}; -certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> - case ssl_manager:lookup_trusted_cert(CertsDbRef, +certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> + case ssl_manager:lookup_trusted_cert(CertDbHandle, CertsDbRef, SerialNr, Issuer) of {ok, {IssuerCert, ErlCert}} -> ErlCert = public_key:pkix_decode_cert(IssuerCert, otp), certificate_chain(ErlCert, IssuerCert, - CertsDbRef, [IssuerCert | Chain]); + CertDbHandle, CertsDbRef, [IssuerCert | Chain]); _ -> %% The trusted cert may be obmitted from the chain as the %% counter part needs to have it anyway to be able to @@ -227,8 +227,8 @@ certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> {ok, lists:reverse(Chain)} end. -find_issuer(OtpCert, PrevCandidateKey) -> - case ssl_manager:issuer_candidate(PrevCandidateKey) of +find_issuer(OtpCert, PrevCandidateKey, CertDbHandle) -> + case ssl_manager:issuer_candidate(PrevCandidateKey, CertDbHandle) of no_more_candidates -> {error, issuer_not_found}; {Key, {_Cert, ErlCertCandidate}} -> @@ -236,7 +236,7 @@ find_issuer(OtpCert, PrevCandidateKey) -> true -> public_key:pkix_issuer_id(ErlCertCandidate, self); false -> - find_issuer(OtpCert, Key) + find_issuer(OtpCert, Key, CertDbHandle) end end. diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 3eceefa304..0560a02110 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -26,8 +26,8 @@ -include_lib("public_key/include/public_key.hrl"). -export([create/0, remove/1, add_trusted_certs/3, - remove_trusted_certs/2, lookup_trusted_cert/3, issuer_candidate/1, - lookup_cached_certs/1, cache_pem_file/4, uncache_pem_file/2, lookup/2]). + remove_trusted_certs/2, lookup_trusted_cert/4, issuer_candidate/2, + 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()}. @@ -36,19 +36,19 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec create() -> certdb_ref(). +-spec create() -> [db_handle()]. %% %% Description: Creates a new certificate db. -%% Note: lookup_trusted_cert/3 may be called from any process but only +%% Note: lookup_trusted_cert/4 may be called from any process but only %% the process that called create may call the other functions. %%-------------------------------------------------------------------- create() -> - [ets:new(certificate_db_name(), [named_table, set, protected]), - ets:new(ssl_file_to_ref, [named_table, set, protected]), + [ets:new(ssl_otp_certificate_db, [set, protected]), + ets:new(ssl_file_to_ref, [set, protected]), ets:new(ssl_pid_to_file, [bag, private])]. %%-------------------------------------------------------------------- --spec remove(certdb_ref()) -> term(). +-spec remove([db_handle()]) -> term(). %% %% Description: Removes database db %%-------------------------------------------------------------------- @@ -56,7 +56,7 @@ remove(Dbs) -> lists:foreach(fun(Db) -> true = ets:delete(Db) end, Dbs). %%-------------------------------------------------------------------- --spec lookup_trusted_cert(reference(), serialnumber(), issuer()) -> +-spec lookup_trusted_cert(db_handle(), certdb_ref(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. %% @@ -64,19 +64,19 @@ remove(Dbs) -> %% <SerialNumber, Issuer>. Ref is used as it is specified %% for each connection which certificates are trusted. %%-------------------------------------------------------------------- -lookup_trusted_cert(Ref, SerialNumber, Issuer) -> - case lookup({Ref, SerialNumber, Issuer}, certificate_db_name()) of +lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> + case lookup({Ref, SerialNumber, Issuer}, DbHandle) of undefined -> undefined; [Certs] -> {ok, Certs} end. -lookup_cached_certs(File) -> - ets:lookup(certificate_db_name(), {file, File}). +lookup_cached_certs(DbHandle, File) -> + ets:lookup(DbHandle, {file, File}). %%-------------------------------------------------------------------- --spec add_trusted_certs(pid(), string() | {der, list()}, certdb_ref()) -> {ok, certdb_ref()}. +-spec add_trusted_certs(pid(), string() | {der, list()}, [db_handle()]) -> {ok, [db_handle()]}. %% %% Description: Adds the trusted certificates from file <File> to the %% runtime database. Returns Ref that should be handed to lookup_trusted_cert @@ -100,7 +100,7 @@ add_trusted_certs(Pid, File, [CertsDb, FileToRefDb, PidToFileDb]) -> insert(Pid, File, PidToFileDb), {ok, Ref}. %%-------------------------------------------------------------------- --spec cache_pem_file(pid(), string(), time(), certdb_ref()) -> term(). +-spec cache_pem_file(pid(), string(), time(), [db_handle()]) -> term(). %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- @@ -112,7 +112,7 @@ cache_pem_file(Pid, File, Time, [CertsDb, _FileToRefDb, PidToFileDb]) -> {ok, Content}. %-------------------------------------------------------------------- --spec uncache_pem_file(string(), certdb_ref()) -> no_return(). +-spec uncache_pem_file(string(), [db_handle()]) -> no_return(). %% %% Description: If a cached file is no longer valid (changed on disk) %% we must terminate the connections using the old file content, and @@ -130,7 +130,7 @@ uncache_pem_file(File, [_CertsDb, _FileToRefDb, PidToFileDb]) -> %%-------------------------------------------------------------------- --spec remove_trusted_certs(pid(), certdb_ref()) -> term(). +-spec remove_trusted_certs(pid(), [db_handle()]) -> term(). %% %% Description: Removes trusted certs originating from @@ -161,7 +161,7 @@ remove_trusted_certs(Pid, [CertsDb, FileToRefDb, PidToFileDb]) -> end. %%-------------------------------------------------------------------- --spec issuer_candidate(no_candidate | cert_key() | {file, term()}) -> +-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 @@ -169,32 +169,30 @@ remove_trusted_certs(Pid, [CertsDb, FileToRefDb, PidToFileDb]) -> %% try to find the issuer in the database over known %% certificates. %%-------------------------------------------------------------------- -issuer_candidate(no_candidate) -> - Db = certificate_db_name(), +issuer_candidate(no_candidate, Db) -> case ets:first(Db) of '$end_of_table' -> no_more_candidates; {file, _} = Key -> - issuer_candidate(Key); + issuer_candidate(Key, Db); Key -> [Cert] = lookup(Key, Db), {Key, Cert} end; -issuer_candidate(PrevCandidateKey) -> - Db = certificate_db_name(), +issuer_candidate(PrevCandidateKey, Db) -> case ets:next(Db, PrevCandidateKey) of '$end_of_table' -> no_more_candidates; {file, _} = Key -> - issuer_candidate(Key); + issuer_candidate(Key, Db); Key -> [Cert] = lookup(Key, Db), {Key, Cert} end. %%-------------------------------------------------------------------- --spec lookup(term(), term()) -> term() | undefined. +-spec lookup(term(), db_handle()) -> term() | undefined. %% %% Description: Looks up an element in a certificat <Db>. %%-------------------------------------------------------------------- @@ -212,9 +210,6 @@ lookup(Key, Db) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_db_name() -> - ssl_otp_certificate_db. - insert(Key, Data, Db) -> true = ets:insert(Db, {Key, Data}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 574e1e9468..c772697f1d 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 @@ -70,6 +69,7 @@ %% {{md5_hash, sha_hash}, {prev_md5, prev_sha}} (binary()) tls_handshake_hashes, % see above tls_cipher_texts, % list() received but not deciphered yet + cert_db, % session, % #session{} from ssl_handshake.hrl session_cache, % session_cache_cb, % @@ -107,12 +107,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec send(pid(), iolist()) -> ok | {error, reason()}. +-spec send(pid(), iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> sync_send_all_state_event(Pid, {application_data, + %% iolist_to_binary should really + %% be called iodata_to_binary() erlang:iolist_to_binary(Data)}, infinity). %%-------------------------------------------------------------------- @@ -124,11 +126,11 @@ send(Pid, Data) -> recv(Pid, Length, Timeout) -> sync_send_all_state_event(Pid, {recv, Length}, Timeout). %%-------------------------------------------------------------------- --spec connect(host(), port_num(), port(), {#ssl_options{}, #socket_options{}}, +-spec connect(host(), inet:port_number(), port(), {#ssl_options{}, #socket_options{}}, pid(), tuple(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Connect to a ssl server. +%% Description: Connect to an ssl server. %%-------------------------------------------------------------------- connect(Host, Port, Socket, Options, User, CbInfo, Timeout) -> try start_fsm(client, Host, Port, Socket, Options, User, CbInfo, @@ -138,11 +140,11 @@ connect(Host, Port, Socket, Options, User, CbInfo, Timeout) -> {error, ssl_not_started} end. %%-------------------------------------------------------------------- --spec ssl_accept(port_num(), port(), {#ssl_options{}, #socket_options{}}, +-spec ssl_accept(inet:port_number(), port(), {#ssl_options{}, #socket_options{}}, pid(), tuple(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% -%% Description: Performs accept on a ssl listen socket. e.i. performs +%% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- ssl_accept(Port, Socket, Opts, User, CbInfo, Timeout) -> @@ -182,7 +184,7 @@ socket_control(Socket, Pid, CbModule) -> %%-------------------------------------------------------------------- -spec close(pid()) -> ok | {error, reason()}. %% -%% Description: Close a ssl connection +%% Description: Close an ssl connection %%-------------------------------------------------------------------- close(ConnectionPid) -> case sync_send_all_state_event(ConnectionPid, close) of @@ -209,14 +211,14 @@ shutdown(ConnectionPid, How) -> new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- --spec sockname(pid()) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec sockname(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- sockname(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, sockname). %%-------------------------------------------------------------------- --spec peername(pid()) -> {ok, {tuple(), port_num()}} | {error, reason()}. +-spec peername(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: Same as inet:peername/1 %%-------------------------------------------------------------------- @@ -274,7 +276,7 @@ renegotiation(ConnectionPid) -> %%==================================================================== %%-------------------------------------------------------------------- --spec start_link(atom(), host(), port_num(), port(), list(), pid(), tuple()) -> +-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_fsm process which calls Module:init/1 to @@ -303,12 +305,13 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, Hashes0 = ssl_handshake:init_hashes(), try ssl_init(SSLOpts0, Role) of - {ok, Ref, CacheRef, OwnCert, Key, DHParams} -> + {ok, Ref, CertDbHandle, CacheHandle, OwnCert, Key, DHParams} -> Session = State0#state.session, State = State0#state{tls_handshake_hashes = Hashes0, session = Session#session{own_certificate = OwnCert}, cert_db_ref = Ref, - session_cache = CacheRef, + cert_db = CertDbHandle, + session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams}, {ok, hello, State, get_timeout(State)} @@ -498,9 +501,10 @@ certify(#certificate{asn1_certificates = []}, certify(#certificate{} = Cert, #state{negotiated_version = Version, role = Role, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, ssl_options = Opts} = State) -> - case ssl_handshake:certify(Cert, CertDbRef, Opts#ssl_options.depth, + case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, Opts#ssl_options.verify_fun, Role) of {PeerCert, PublicKeyInfo} -> @@ -857,23 +861,23 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, #state{socket_options = Opts1, socket = Socket, user_data_buffer = Buffer} = State0) -> - Opts = set_socket_opts(Socket, Opts0, Opts1, []), + {Reply, Opts} = set_socket_opts(Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> - {reply, ok, StateName, State1, get_timeout(State1)}; + {reply, Reply, StateName, State1, get_timeout(State1)}; 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 {next_state, StateName, State, Timeout} -> - {reply, ok, StateName, State, Timeout}; + {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> {stop, Reason, State} end; Buffer =:= <<>> -> %% Active once already set - {reply, ok, StateName, State1, get_timeout(State1)}; + {reply, Reply, StateName, State1, get_timeout(State1)}; true -> case application_data(<<>>, State1) of Stop = {stop,_,_} -> @@ -881,7 +885,7 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, {Record, State2} -> case next_state(StateName, Record, State2) of {next_state, StateName, State, Timeout} -> - {reply, ok, StateName, State, Timeout}; + {reply, Reply, StateName, State, Timeout}; {stop, Reason, State} -> {stop, Reason, State} end @@ -939,17 +943,23 @@ handle_info({Protocol, _, Data}, StateName, handle_info({CloseTag, Socket}, _StateName, #state{socket = Socket, close_tag = CloseTag, - negotiated_version = Version, host = Host, - port = Port, socket_options = Opts, + negotiated_version = Version, + socket_options = Opts, user_application = {_Mon,Pid}, from = From, - role = Role, session = Session} = State) -> - %% Debug option maybe, the user do NOT want to see these in their logs - %% error_logger:info_report("SSL: Peer did not send close notify alert."), + role = Role} = 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 + %% with widespread implementation practice. case Version of {1, N} when N >= 1 -> ok; _ -> - invalidate_session(Role, Host, Port, Session) + %% As invalidate_sessions here causes performance issues, + %% we will conform to the widespread implementation + %% practice and go aginst the spec + %%invalidate_session(Role, Host, Port, Session) + ok end, alert_user(Opts#socket_options.active, Pid, From, ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Role), @@ -1022,7 +1032,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, @@ -1033,22 +1044,43 @@ 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) -> - {ok, CertDbRef, CacheRef, OwnCert} = init_certificates(SslOpts, Role), + + init_manager_name(SslOpts#ssl_options.erl_dist), + + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = - init_private_key(SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, + init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, SslOpts#ssl_options.password, Role), - DHParams = init_diffie_hellman(SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), - {ok, CertDbRef, CacheRef, OwnCert, PrivateKey, DHParams}. + 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, certfile = CertFile, cert = Cert}, Role) -> - {ok, CertDbRef, CacheRef} = + {ok, CertDbRef, CertDbHandle, CacheHandle} = try Certs = case CaCerts of undefined -> @@ -1056,44 +1088,44 @@ init_certificates(#ssl_options{cacerts = CaCerts, _ -> {der, CaCerts} end, - {ok, _, _} = ssl_manager:connection_init(Certs, Role) + {ok, _, _, _} = ssl_manager:connection_init(Certs, Role) catch Error:Reason -> handle_file_error(?LINE, Error, Reason, CACertFile, ecacertfile, erlang:get_stacktrace()) end, - init_certificates(Cert, CertDbRef, CacheRef, CertFile, Role). + init_certificates(Cert, CertDbRef, CertDbHandle, CacheHandle, CertFile, Role). -init_certificates(undefined, CertDbRef, CacheRef, "", _) -> - {ok, CertDbRef, CacheRef, undefined}; +init_certificates(undefined, CertDbRef, CertDbHandle, CacheHandle, "", _) -> + {ok, CertDbRef, CertDbHandle, CacheHandle, undefined}; -init_certificates(undefined, CertDbRef, CacheRef, CertFile, client) -> +init_certificates(undefined, CertDbRef, CertDbHandle, CacheHandle, CertFile, client) -> try - [OwnCert] = ssl_certificate:file_to_certificats(CertFile), - {ok, CertDbRef, CacheRef, OwnCert} + [OwnCert] = ssl_certificate:file_to_certificats(CertFile, CertDbHandle), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} catch _Error:_Reason -> - {ok, CertDbRef, CacheRef, undefined} + {ok, CertDbRef, CertDbHandle, CacheHandle, undefined} end; -init_certificates(undefined, CertDbRef, CacheRef, CertFile, server) -> +init_certificates(undefined, CertDbRef, CertDbHandle, CacheRef, CertFile, server) -> try - [OwnCert] = ssl_certificate:file_to_certificats(CertFile), - {ok, CertDbRef, CacheRef, OwnCert} + [OwnCert] = ssl_certificate:file_to_certificats(CertFile, CertDbHandle), + {ok, CertDbRef, CertDbHandle, CacheRef, OwnCert} catch Error:Reason -> handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, erlang:get_stacktrace()) end; -init_certificates(Cert, CertDbRef, CacheRef, _, _) -> - {ok, CertDbRef, CacheRef, Cert}. +init_certificates(Cert, CertDbRef, CertDbHandle, CacheRef, _, _) -> + {ok, CertDbRef, CertDbHandle, CacheRef, Cert}. -init_private_key(undefined, "", _Password, _Client) -> +init_private_key(_, undefined, "", _Password, _Client) -> undefined; -init_private_key(undefined, KeyFile, Password, _) -> +init_private_key(DbHandle, undefined, KeyFile, Password, _) -> try - {ok, List} = ssl_manager:cache_pem_file(KeyFile), + {ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle), [PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List, - PKey =:= 'RSAPrivateKey' orelse + PKey =:= 'RSAPrivateKey' orelse PKey =:= 'DSAPrivateKey'], public_key:pem_entry_decode(PemEntry, Password) catch @@ -1102,9 +1134,9 @@ init_private_key(undefined, KeyFile, Password, _) -> erlang:get_stacktrace()) end; -init_private_key({rsa, PrivateKey}, _, _,_) -> +init_private_key(_,{rsa, PrivateKey}, _, _,_) -> public_key:der_decode('RSAPrivateKey', PrivateKey); -init_private_key({dsa, PrivateKey},_,_,_) -> +init_private_key(_,{dsa, PrivateKey},_,_,_) -> public_key:der_decode('DSAPrivateKey', PrivateKey). -spec(handle_file_error(_,_,_,_,_,_) -> no_return()). @@ -1120,15 +1152,15 @@ file_error(Line, Error, Reason, File, Throw, Stack) -> error_logger:error_report(Report), throw(Throw). -init_diffie_hellman(Params, _,_) when is_binary(Params)-> +init_diffie_hellman(_,Params, _,_) when is_binary(Params)-> public_key:der_decode('DHParameter', Params); -init_diffie_hellman(_,_, client) -> +init_diffie_hellman(_,_,_, client) -> undefined; -init_diffie_hellman(_,undefined, _) -> +init_diffie_hellman(_,_,undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; -init_diffie_hellman(_, DHParamFile, server) -> +init_diffie_hellman(DbHandle,_, DHParamFile, server) -> try - {ok, List} = ssl_manager:cache_pem_file(DHParamFile), + {ok, List} = ssl_manager:cache_pem_file(DHParamFile,DbHandle), case [Entry || Entry = {'DHParameter', _ , _} <- List] of [Entry] -> public_key:pem_entry_decode(Entry); @@ -1172,11 +1204,12 @@ certify_client(#state{client_certificate_requested = true, role = client, connection_states = ConnectionStates0, transport_cb = Transport, negotiated_version = Version, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}, socket = Socket, tls_handshake_hashes = Hashes0} = State) -> - Certificate = ssl_handshake:certificate(OwnCert, CertDbRef, client), + Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), {BinCert, ConnectionStates1, Hashes1} = encode_handshake(Certificate, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinCert), @@ -1357,9 +1390,10 @@ certify_server(#state{transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates, tls_handshake_hashes = Hashes, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}} = State) -> - case ssl_handshake:certificate(OwnCert, CertDbRef, server) of + case ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of CertMsg = #certificate{} -> {BinCertMsg, NewConnectionStates, NewHashes} = encode_handshake(CertMsg, Version, ConnectionStates, Hashes), @@ -1446,12 +1480,13 @@ rsa_key_exchange(_, _) -> request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, connection_states = ConnectionStates0, + cert_db = CertDbHandle, cert_db_ref = CertDbRef, tls_handshake_hashes = Hashes0, negotiated_version = Version, socket = Socket, transport_cb = Transport} = State) -> - Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbRef), + Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef), {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(Msg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinMsg), @@ -1764,7 +1799,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). @@ -2032,31 +2068,69 @@ get_socket_opts(Socket, [active | Tags], SockOpts, Acc) -> get_socket_opts(Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); get_socket_opts(Socket, [Tag | Tags], SockOpts, Acc) -> - case inet:getopts(Socket, [Tag]) of + try inet:getopts(Socket, [Tag]) of {ok, [Opt]} -> get_socket_opts(Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> - {error, Error} - end. + {error, {eoptions, {inet_option, Tag, Error}}} + catch + %% So that inet behavior does not crash our process + _:Error -> {error, {eoptions, {inet_option, Tag, Error}}} + end; +get_socket_opts(_,Opts, _,_) -> + {error, {eoptions, {inet_option, Opts, function_clause}}}. set_socket_opts(_, [], SockOpts, []) -> - SockOpts; + {ok, SockOpts}; set_socket_opts(Socket, [], SockOpts, Other) -> %% Set non emulated options - inet:setopts(Socket, Other), - SockOpts; -set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) -> + try inet:setopts(Socket, Other) of + ok -> + {ok, SockOpts}; + {error, InetError} -> + {{error, {eoptions, {inet_options, Other, InetError}}}, SockOpts} + catch + _:Error -> + %% So that inet behavior does not crash our process + {{error, {eoptions, {inet_options, Other, Error}}}, SockOpts} + end; + +set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> set_socket_opts(Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{mode, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; + Packet == 0; + Packet == 1; + Packet == 2; + Packet == 4; + Packet == asn1; + Packet == cdr; + Packet == sunrm; + Packet == fcgi; + Packet == tpkt; + Packet == line; + Packet == http; + Packet == httph; + Packet == http_bin; + Packet == httph_bin -> set_socket_opts(Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{packet, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> set_socket_opts(Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) -> +set_socket_opts(_, [{header, _} = Opt| _], SockOpts, _) -> + {{error,{eoptions, {inet_opt, Opt}}}, SockOpts}; +set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; + Active == true; + Active == false -> set_socket_opts(Socket, Opts, SockOpts#socket_options{active = Active}, Other); +set_socket_opts(_, [{active, _} = Opt| _], SockOpts, _) -> + {{error, {eoptions, {inet_opt, Opt}} }, SockOpts}; set_socket_opts(Socket, [Opt | Opts], SockOpts, Other) -> set_socket_opts(Socket, Opts, SockOpts, [Opt | Other]). 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..c1912401d7 --- /dev/null +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -0,0 +1,84 @@ +%% +%% %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 +%%%========================================================================= +-spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. + +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 1f4c44d115..f873a6a913 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -31,14 +31,16 @@ -include_lib("public_key/include/public_key.hrl"). -export([master_secret/4, client_hello/6, server_hello/4, hello/4, - hello_request/0, certify/6, certificate/3, + hello_request/0, certify/7, certificate/4, client_certificate_verify/5, certificate_verify/5, - certificate_request/2, key_exchange/2, server_key_exchange_hash/2, + certificate_request/3, key_exchange/2, server_key_exchange_hash/2, finished/4, verify_connection/5, get_tls_handshake/2, decode_client_key/3, server_hello_done/0, 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{} | @@ -48,7 +50,7 @@ %% Internal application API %%==================================================================== %%-------------------------------------------------------------------- --spec client_hello(host(), port_num(), #connection_states{}, +-spec client_hello(host(), inet:port_number(), #connection_states{}, #ssl_options{}, boolean(), der_cert()) -> #client_hello{}. %% %% Description: Creates a client hello message. @@ -106,7 +108,7 @@ hello_request() -> %%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, - #connection_states{} | {port_num(), #session{}, cache_ref(), + #connection_states{} | {inet:port_number(), #session{}, db_handle(), atom(), #connection_states{}, binary()}, boolean()) -> {tls_version(), session_id(), #connection_states{}}| {tls_version(), {resumed | new, #session{}}, @@ -173,13 +175,13 @@ hello(#client_hello{client_version = ClientVersion, random = Random, end. %%-------------------------------------------------------------------- --spec certify(#certificate{}, term(), integer() | nolimit, +-spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, verify_peer | verify_none, {fun(), term}, client | server) -> {der_cert(), public_key_info()} | #alert{}. %% %% Description: Handles a certificate handshake message %%-------------------------------------------------------------------- -certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, +certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, MaxPathLen, _Verify, VerifyFunAndState, Role) -> [PeerCert | _] = ASN1Certs, @@ -208,7 +210,7 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, end, {TrustedErlCert, CertPath} = - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef), + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef), case public_key:pkix_path_validation(TrustedErlCert, CertPath, @@ -222,13 +224,13 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, end. %%-------------------------------------------------------------------- --spec certificate(der_cert(), term(), client | server) -> #certificate{} | #alert{}. +-spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}. %% %% Description: Creates a certificate message. %%-------------------------------------------------------------------- -certificate(OwnCert, CertDbRef, client) -> +certificate(OwnCert, CertDbHandle, CertDbRef, client) -> Chain = - case ssl_certificate:certificate_chain(OwnCert, CertDbRef) of + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, CertChain} -> CertChain; {error, _} -> @@ -239,8 +241,8 @@ certificate(OwnCert, CertDbRef, client) -> end, #certificate{asn1_certificates = Chain}; -certificate(OwnCert, CertDbRef, server) -> - case ssl_certificate:certificate_chain(OwnCert, CertDbRef) of +certificate(OwnCert, CertDbHandle, CertDbRef, server) -> + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, Chain} -> #certificate{asn1_certificates = Chain}; {error, _} -> @@ -302,17 +304,17 @@ certificate_verify(Signature, {?'id-dsa' = Algorithm, PublicKey, PublicKeyParams %%-------------------------------------------------------------------- --spec certificate_request(#connection_states{}, certdb_ref()) -> +-spec certificate_request(#connection_states{}, db_handle(), certdb_ref()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- -certificate_request(ConnectionStates, CertDbRef) -> +certificate_request(ConnectionStates, CertDbHandle, CertDbRef) -> #connection_state{security_parameters = #security_parameters{cipher_suite = CipherSuite}} = ssl_record:pending_connection_state(ConnectionStates, read), Types = certificate_types(CipherSuite), - Authorities = certificate_authorities(CertDbRef), + Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, certificate_authorities = Authorities @@ -383,8 +385,9 @@ master_secret(Version, #session{master_secret = Mastersecret}, ConnectionStates, Role) catch exit:Reason -> - error_logger:error_report("Key calculation failed due to ~p", - [Reason]), + Report = io_lib:format("Key calculation failed due to ~p", + [Reason]), + error_logger:error_report(Report), ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end; @@ -400,8 +403,9 @@ master_secret(Version, PremasterSecret, ConnectionStates, Role) -> SecParams, ConnectionStates, Role) catch exit:Reason -> - error_logger:error_report("Master secret calculation failed" - " due to ~p", [Reason]), + Report = io_lib:format("Master secret calculation failed" + " due to ~p", [Reason]), + error_logger:error_report(Report), ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end. @@ -910,9 +914,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. @@ -1071,8 +1078,8 @@ certificate_types({KeyExchange, _, _, _}) certificate_types(_) -> <<?BYTE(?RSA_SIGN)>>. -certificate_authorities(CertDbRef) -> - Authorities = certificate_authorities_from_db(CertDbRef), +certificate_authorities(CertDbHandle, CertDbRef) -> + Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef), Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> OTPSubj = TBSCert#'OTPTBSCertificate'.subject, DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), @@ -1084,18 +1091,18 @@ certificate_authorities(CertDbRef) -> end, list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]). -certificate_authorities_from_db(CertDbRef) -> - certificate_authorities_from_db(CertDbRef, no_candidate, []). +certificate_authorities_from_db(CertDbHandle, CertDbRef) -> + certificate_authorities_from_db(CertDbHandle, CertDbRef, no_candidate, []). -certificate_authorities_from_db(CertDbRef, PrevKey, Acc) -> - case ssl_manager:issuer_candidate(PrevKey) of +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(CertDbRef, Key, [Cert|Acc]); + certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, [Cert|Acc]); {Key, _Cert} -> %% skip certs not from this ssl connection - certificate_authorities_from_db(CertDbRef, Key, Acc) + certificate_authorities_from_db(CertDbHandle, CertDbRef, Key, Acc) end. digitally_signed(Hash, #'RSAPrivateKey'{} = 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 c28daa271e..18cfcdcd68 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -24,17 +24,19 @@ -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(). -type from() :: term(). --type host() :: string() | tuple(). --type port_num() :: integer(). +-type host() :: inet:ip_address() | inet:hostname(). -type session_id() :: 0 | binary(). -type tls_version() :: {integer(), integer()}. -type tls_atom_version() :: sslv3 | tlsv1. --type cache_ref() :: term(). --type certdb_ref() :: term(). +-type certdb_ref() :: reference(). +-type db_handle() :: term(). -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | dh_anon. -type der_cert() :: binary(). -type private_key() :: #'RSAPrivateKey'{} | #'DSAPrivateKey'{}. @@ -99,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 f845b1ecc0..dcf310c535 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.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 @@ -27,9 +27,9 @@ -include("ssl_internal.hrl"). %% Internal application API --export([start_link/1, - connection_init/2, cache_pem_file/1, - lookup_trusted_cert/3, issuer_candidate/1, client_session_id/4, +-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, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -50,13 +50,15 @@ session_cache_cb, session_lifetime, certificate_db, - session_validation_timer + session_validation_timer, + last_delay_timer %% Keep for testing purposes }). -define('24H_in_msec', 8640000). -define('24H_in_sec', 8640). -define(SESSION_VALIDATION_INTERVAL, 60000). -define(CERTIFICATE_CACHE_CLEANUP, 30000). +-define(CLEAN_SESSION_DB, 60000). %%==================================================================== %% API @@ -64,51 +66,64 @@ %%-------------------------------------------------------------------- -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 connection_init(string()| {der, list()}, client | server) -> {ok, reference(), cache_ref()}. +-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) -> + {ok, certdb_ref(), db_handle(), db_handle()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- connection_init(Trustedcerts, Role) -> call({connection_init, Trustedcerts, Role}). %%-------------------------------------------------------------------- --spec cache_pem_file(string()) -> {ok, term()} | {error, reason()}. +-spec cache_pem_file(string(), term()) -> {ok, term()} | {error, reason()}. %% %% Description: Cach a pem file and return its content. %%-------------------------------------------------------------------- -cache_pem_file(File) -> +cache_pem_file(File, DbHandle) -> try file:read_file_info(File) of {ok, #file_info{mtime = LastWrite}} -> - cache_pem_file(File, LastWrite) + cache_pem_file(File, LastWrite, DbHandle) catch _:Reason -> {error, Reason} end. %%-------------------------------------------------------------------- --spec lookup_trusted_cert(reference(), serialnumber(), issuer()) -> +-spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. %% %% Description: Lookup the trusted cert with Key = {reference(), %% serialnumber(), issuer()}. %% -------------------------------------------------------------------- -lookup_trusted_cert(Ref, SerialNumber, Issuer) -> - ssl_certificate_db:lookup_trusted_cert(Ref, SerialNumber, Issuer). +lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> + ssl_certificate_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- --spec issuer_candidate(cert_key() | no_candidate) -> - {cert_key(), {der_cert(), #'OTPCertificate'{}}} | no_more_candidates. +-spec issuer_candidate(cert_key() | no_candidate, term()) -> + {cert_key(), + {der_cert(), + #'OTPCertificate'{}}} | no_more_candidates. %% %% Description: Return next issuer candidate. %%-------------------------------------------------------------------- -issuer_candidate(PrevCandidateKey) -> - ssl_certificate_db:issuer_candidate(PrevCandidateKey). +issuer_candidate(PrevCandidateKey, DbHandle) -> + ssl_certificate_db:issuer_candidate(PrevCandidateKey, DbHandle). %%-------------------------------------------------------------------- --spec client_session_id(host(), port_num(), #ssl_options{}, +-spec client_session_id(host(), inet:port_number(), #ssl_options{}, der_cert() | undefined) -> session_id(). %% %% Description: Select a session id for the client. @@ -117,7 +132,8 @@ client_session_id(Host, Port, SslOpts, OwnCert) -> call({client_session_id, Host, Port, SslOpts, OwnCert}). %%-------------------------------------------------------------------- --spec server_session_id(host(), port_num(), #ssl_options{}, der_cert()) -> session_id(). +-spec server_session_id(host(), inet:port_number(), #ssl_options{}, + der_cert()) -> session_id(). %% %% Description: Select a session id for the server. %%-------------------------------------------------------------------- @@ -125,8 +141,8 @@ server_session_id(Port, SuggestedSessionId, SslOpts, OwnCert) -> call({server_session_id, Port, SuggestedSessionId, SslOpts, OwnCert}). %%-------------------------------------------------------------------- --spec register_session(port_num(), #session{}) -> ok. --spec register_session(host(), port_num(), #session{}) -> ok. +-spec register_session(inet:port_number(), #session{}) -> ok. +-spec register_session(host(), inet:port_number(), #session{}) -> ok. %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- @@ -136,10 +152,12 @@ register_session(Host, Port, Session) -> register_session(Port, Session) -> cast({register_session, Port, Session}). %%-------------------------------------------------------------------- --spec invalidate_session(port_num(), #session{}) -> ok. --spec invalidate_session(host(), port_num(), #session{}) -> ok. +-spec invalidate_session(inet:port_number(), #session{}) -> ok. +-spec invalidate_session(host(), inet:port_number(), #session{}) -> ok. %% -%% Description: Make the session unavilable for reuse. +%% Description: Make the session unavailable for reuse. After +%% a the session has been marked "is_resumable = false" for some while +%% it will be safe to remove the data from the session database. %%-------------------------------------------------------------------- invalidate_session(Host, Port, Session) -> cast({invalidate_session, Host, Port, Session}). @@ -158,7 +176,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 = @@ -185,19 +204,20 @@ init([Opts]) -> %% Description: Handling call messages %%-------------------------------------------------------------------- handle_call({{connection_init, "", _Role}, Pid}, _From, - #state{session_cache = Cache} = State) -> + #state{certificate_db = [CertDb |_], + session_cache = Cache} = State) -> erlang:monitor(process, Pid), - Result = {ok, make_ref(), Cache}, + Result = {ok, make_ref(),CertDb, Cache}, {reply, Result, State}; handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, - #state{certificate_db = Db, + #state{certificate_db = [CertDb|_] =Db, session_cache = Cache} = State) -> erlang:monitor(process, Pid), Result = try {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, Trustedcerts, Db), - {ok, Ref, Cache} + {ok, Ref, CertDb, Cache} catch _:Reason -> {error, Reason} @@ -258,24 +278,32 @@ handle_cast({register_session, Port, Session}, CacheCb:update(Cache, {Port, NewSession#session.session_id}, NewSession), {noreply, State}; -handle_cast({invalidate_session, Host, Port, - #session{session_id = ID}}, +%%% 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:delete(Cache, {{Host, Port}, ID}), - {noreply, 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}}; -handle_cast({invalidate_session, Port, #session{session_id = ID}}, +handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - CacheCb:delete(Cache, {Port, ID}), - {noreply, 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}}; handle_cast({recache_pem, File, LastWrite, Pid, From}, #state{certificate_db = [_, FileToRefDb, _]} = State0) -> case ssl_certificate_db:lookup(File, FileToRefDb) of undefined -> - {reply, Msg, State} = handle_call({{cache_pem, File, LastWrite}, Pid}, From, State0), + {reply, Msg, State} = + handle_call({{cache_pem, File, LastWrite}, Pid}, From, State0), gen_server:reply(From, Msg), {noreply, State}; _ -> %% Send message to self letting cleanup messages be handled @@ -302,6 +330,12 @@ handle_info(validate_sessions, #state{session_cache_cb = CacheCb, start_session_validator(Cache, CacheCb, LifeTime), {noreply, State#state{session_validation_timer = Timer}}; +handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, + session_cache_cb = CacheCb + } = State) -> + CacheCb:delete(Cache, Key), + {noreply, State}; + handle_info({'EXIT', _, _}, State) -> %% Session validator died!! Do we need to take any action? %% maybe error log @@ -353,10 +387,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 @@ -376,9 +410,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). @@ -389,8 +424,8 @@ session_validation({{Port, _}, Session}, LifeTime) -> validate_session(Port, Session, LifeTime), LifeTime. -cache_pem_file(File, LastWrite) -> - case ssl_certificate_db:lookup_cached_certs(File) of +cache_pem_file(File, LastWrite, DbHandle) -> + case ssl_certificate_db:lookup_cached_certs(DbHandle,File) of [{_, {Mtime, Content}}] -> case LastWrite of Mtime -> @@ -401,3 +436,11 @@ cache_pem_file(File, LastWrite) -> [] -> call({cache_pem, File, LastWrite}) end. + +delay_time() -> + case application:get_env(ssl, session_delay_cleanup_time) of + {ok, Time} when is_integer(Time) -> + Time; + _ -> + ?CLEAN_SESSION_DB + end. 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 f1c0073965..72091fdd5f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.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 @@ -62,6 +62,8 @@ -compile(inline). +-define(INITIAL_BYTES, 5). + %%==================================================================== %% Internal application API %%==================================================================== @@ -340,7 +342,7 @@ get_tls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), get_tls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, version = {MajVer, MinVer}, fragment = Data} | Acc]); -%% Matches a ssl v2 client hello message. +%% Matches an ssl v2 client hello message. %% The server must be able to receive such messages, from clients that %% are willing to use ssl v3 or higher, but have ssl v2 compatibility. get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, @@ -360,16 +362,20 @@ get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), ?UINT16(Length), _/binary>>, - _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH-> + _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH-> + when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); get_tls_records_aux(Data, Acc) -> - {lists:reverse(Acc), Data}. - + case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of + true -> + {lists:reverse(Acc), Data}; + false -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> tls_version() | tls_atom_version(). 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 dc4b7a711c..bf738649f6 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.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 @@ -48,7 +48,7 @@ is_new(_ClientSuggestion, _ServerDecision) -> true. %%-------------------------------------------------------------------- --spec id({host(), port_num(), #ssl_options{}}, cache_ref(), atom(), +-spec id({host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(), undefined | binary()) -> binary(). %% %% Description: Should be called by the client side to get an id @@ -63,7 +63,7 @@ id(ClientInfo, Cache, CacheCb, OwnCert) -> end. %%-------------------------------------------------------------------- --spec id(port_num(), binary(), #ssl_options{}, cache_ref(), +-spec id(inet:port_number(), binary(), #ssl_options{}, db_handle(), atom(), seconds(), binary()) -> binary(). %% %% Description: Should be called by the server side to get an id diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 823bf7acfa..93969f628f 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.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 @@ -28,10 +28,10 @@ -export([init/1, terminate/1, lookup/2, update/3, delete/2, foldl/3, select_session/2]). --type key() :: {{host(), port_num()}, session_id()} | {port_num(), session_id()}. +-type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. %%-------------------------------------------------------------------- --spec init(list()) -> cache_ref(). %% Returns reference to the cache (opaque) +-spec init(list()) -> db_handle(). %% Returns reference to the cache (opaque) %% %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- @@ -39,7 +39,7 @@ init(_) -> ets:new(cache_name(), [set, protected]). %%-------------------------------------------------------------------- --spec terminate(cache_ref()) -> any(). %% +-spec terminate(db_handle()) -> any(). %% %% Description: Handles cache table at termination of ssl manager. %%-------------------------------------------------------------------- @@ -47,7 +47,7 @@ terminate(Cache) -> ets:delete(Cache). %%-------------------------------------------------------------------- --spec lookup(cache_ref(), key()) -> #session{} | undefined. +-spec lookup(db_handle(), key()) -> #session{} | undefined. %% %% Description: Looks up a cach entry. Should be callable from any %% process. @@ -61,7 +61,7 @@ lookup(Cache, Key) -> end. %%-------------------------------------------------------------------- --spec update(cache_ref(), key(), #session{}) -> any(). +-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,7 +70,7 @@ update(Cache, Key, Session) -> ets:insert(Cache, {Key, Session}). %%-------------------------------------------------------------------- --spec delete(cache_ref(), key()) -> any(). +-spec delete(db_handle(), key()) -> any(). %% %% Description: Delets a cache entry. %% Will only be called from the ssl_manager process. @@ -79,7 +79,7 @@ delete(Cache, Key) -> ets:delete(Cache, Key). %%-------------------------------------------------------------------- --spec foldl(fun(), term(), cache_ref()) -> term(). +-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 @@ -91,7 +91,7 @@ foldl(Fun, Acc0, Cache) -> ets:foldl(Fun, Acc0, Cache). %%-------------------------------------------------------------------- --spec select_session(cache_ref(), {host(), port_num()} | port_num()) -> [#session{}]. +-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_ssl2.erl b/lib/ssl/src/ssl_ssl2.erl index b1005b1acb..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 @@ -20,7 +20,7 @@ %% %%---------------------------------------------------------------------- %% Purpose: Handles sslv2 hello as clients supporting sslv2 and higher -%% will send a sslv2 hello. +%% will send an sslv2 hello. %%---------------------------------------------------------------------- -module(ssl_ssl2). diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 316ed8a4e9..cb10b1362a 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]). @@ -51,17 +51,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 +101,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..d63eada571 --- /dev/null +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -0,0 +1,325 @@ +%% +%% %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_remote_id/2]). +-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). + +get_remote_id(Socket, Node) -> + gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, 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}]), + TcpAddress = get_tcp_address(Socket), + 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), + ok = gen_tcp:controlling_process(Socket, From), + flush_old_controller(From, Socket), + {reply, Res, State}; + {Pid, Error} -> + {reply, Error, State} + end; + +handle_call({get_remote_id, {Socket,_Node}}, _From, State) -> + Address = get_tcp_address(Socket), + {reply, Address, State}; + +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) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address{ + address = Address, + host = Host, + protocol = proxy, + family = inet + }. + +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}, binary, {packet,?PPRE}]), + #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), + 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) + 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. |