aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ssl/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ssl/src')
-rw-r--r--lib/ssl/src/Makefile12
-rw-r--r--lib/ssl/src/inet_ssl_dist.erl456
-rw-r--r--lib/ssl/src/inet_tls_dist.erl275
-rw-r--r--lib/ssl/src/ssl.app.src10
-rw-r--r--lib/ssl/src/ssl.appup.src2
-rw-r--r--lib/ssl/src/ssl.erl385
-rw-r--r--lib/ssl/src/ssl_broker.erl1188
-rw-r--r--lib/ssl/src/ssl_broker_int.hrl38
-rw-r--r--lib/ssl/src/ssl_broker_sup.erl46
-rw-r--r--lib/ssl/src/ssl_cipher.erl80
-rw-r--r--lib/ssl/src/ssl_connection.erl53
-rw-r--r--lib/ssl/src/ssl_connection_sup.erl12
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl84
-rw-r--r--lib/ssl/src/ssl_int.hrl99
-rw-r--r--lib/ssl/src/ssl_internal.hrl7
-rw-r--r--lib/ssl/src/ssl_manager.erl28
-rw-r--r--lib/ssl/src/ssl_prim.erl173
-rw-r--r--lib/ssl/src/ssl_server.erl1378
-rw-r--r--lib/ssl/src/ssl_sup.erl42
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl325
20 files changed, 930 insertions, 3763 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 29674f30da..1b07e76d6a 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,6 +1,7 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {"4.1.6", [{restart_application, ssl}]},
{"4.1.5", [{restart_application, ssl}]},
{"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
@@ -10,6 +11,7 @@
{"4.0.1", [{restart_application, ssl}]}
],
[
+ {"4.1.6", [{restart_application, ssl}]},
{"4.1.5", [{restart_application, ssl}]},
{"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index d1ec0c141e..d0693445e0 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -25,18 +25,15 @@
-export([start/0, start/1, stop/0, transport_accept/1,
transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3,
- ciphers/0, cipher_suites/0, cipher_suites/1, close/1, shutdown/2,
+ cipher_suites/0, cipher_suites/1, close/1, shutdown/2,
connect/3, connect/2, connect/4, connection_info/1,
- controlling_process/2, listen/2, pid/1, peername/1, recv/2, recv/3,
- send/2, getopts/2, setopts/2, seed/1, sockname/1, peercert/1,
- peercert/2, version/0, versions/0, session_info/1, format_error/1,
+ controlling_process/2, listen/2, pid/1, peername/1, peercert/1,
+ recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1,
+ versions/0, session_info/1, format_error/1,
renegotiate/1]).
-%% Should be deprecated as soon as old ssl is removed
-%%-deprecated({pid, 1, next_major_release}).
--deprecated({peercert, 2, next_major_release}).
+-deprecated({pid, 1, next_major_release}).
--include("ssl_int.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
-include("ssl_cipher.hrl").
@@ -134,20 +131,13 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
connect(Host, Port, Options) ->
connect(Host, Port, Options, infinity).
-connect(Host, Port, Options0, Timeout) ->
- case proplists:get_value(ssl_imp, Options0, new) of
- new ->
- new_connect(Host, Port, Options0, Timeout);
- old ->
- %% Allow the option reuseaddr to be present
- %% so that new and old ssl can be run by the same
- %% code, however the option will be ignored by old ssl
- %% that hardcodes reuseaddr to true in its portprogram.
- Options1 = proplists:delete(reuseaddr, Options0),
- Options = proplists:delete(ssl_imp, Options1),
- old_connect(Host, Port, Options, Timeout);
- Value ->
- {error, {eoptions, {ssl_imp, Value}}}
+connect(Host, Port, Options, Timeout) ->
+ try handle_options(Options, client) of
+ {ok, Config} ->
+ do_connect(Host,Port,Config,Timeout)
+ catch
+ throw:Error ->
+ Error
end.
%%--------------------------------------------------------------------
@@ -159,21 +149,19 @@ connect(Host, Port, Options0, Timeout) ->
listen(_Port, []) ->
{error, enooptions};
listen(Port, Options0) ->
- case proplists:get_value(ssl_imp, Options0, new) of
- new ->
- new_listen(Port, Options0);
- old ->
- %% Allow the option reuseaddr to be present
- %% so that new and old ssl can be run by the same
- %% code, however the option will be ignored by old ssl
- %% that hardcodes reuseaddr to true in its portprogram.
- Options1 = proplists:delete(reuseaddr, Options0),
- Options = proplists:delete(ssl_imp, Options1),
- old_listen(Port, Options);
- Value ->
- {error, {eoptions, {ssl_imp, Value}}}
+ try
+ {ok, Config} = handle_options(Options0, server),
+ #config{cb={CbModule, _, _, _},inet_user=Options} = Config,
+ case CbModule:listen(Port, Options) of
+ {ok, ListenSocket} ->
+ {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}};
+ Err = {error, _} ->
+ Err
+ end
+ catch
+ Error = {error, _} ->
+ Error
end.
-
%%--------------------------------------------------------------------
-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
{error, reason()}.
@@ -185,8 +173,7 @@ listen(Port, Options0) ->
transport_accept(ListenSocket) ->
transport_accept(ListenSocket, infinity).
-transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}},
- fd = new_ssl}, Timeout) ->
+transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) ->
%% The setopt could have been invoked on the listen socket
%% and options should be inherited.
@@ -208,12 +195,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}
end;
{error, Reason} ->
{error, Reason}
- end;
-
-transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(acceptor),
- ssl_broker:transport_accept(Pid, ListenSocket, Timeout).
+ end.
%%--------------------------------------------------------------------
-spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
@@ -227,16 +209,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
ssl_accept(ListenSocket) ->
ssl_accept(ListenSocket, infinity).
-ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) ->
+ssl_accept(#sslsocket{} = Socket, Timeout) ->
ssl_connection:handshake(Socket, Timeout);
ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
- ssl_accept(ListenSocket, SslOptions, infinity);
-
-%% Old ssl
-ssl_accept(#sslsocket{} = Socket, Timeout) ->
- ensure_old_ssl_started(),
- ssl_broker:ssl_accept(Socket, Timeout).
+ ssl_accept(ListenSocket, SslOptions, infinity).
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
EmulatedOptions = emulated_options(),
@@ -257,25 +234,18 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
%%
%% Description: Close an ssl connection
%%--------------------------------------------------------------------
-close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) ->
+close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) ->
CbMod:close(ListenSocket);
-close(#sslsocket{pid = Pid, fd = new_ssl}) ->
- ssl_connection:close(Pid);
-close(Socket = #sslsocket{}) ->
- ensure_old_ssl_started(),
- ssl_broker:close(Socket).
+close(#sslsocket{pid = Pid}) ->
+ ssl_connection:close(Pid).
%%--------------------------------------------------------------------
-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
%%
%% Description: Sends data over the ssl connection
%%--------------------------------------------------------------------
-send(#sslsocket{pid = Pid, fd = new_ssl}, Data) ->
- ssl_connection:send(Pid, Data);
-
-send(#sslsocket{} = Socket, Data) ->
- ensure_old_ssl_started(),
- ssl_broker:send(Socket, Data).
+send(#sslsocket{pid = Pid}, Data) ->
+ ssl_connection:send(Pid, Data).
%%--------------------------------------------------------------------
-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
@@ -286,11 +256,7 @@ send(#sslsocket{} = Socket, Data) ->
recv(Socket, Length) ->
recv(Socket, Length, infinity).
recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) ->
- ssl_connection:recv(Pid, Length, Timeout);
-
-recv(Socket = #sslsocket{}, Length, Timeout) ->
- ensure_old_ssl_started(),
- ssl_broker:recv(Socket, Length, Timeout).
+ ssl_connection:recv(Pid, Length, Timeout).
%%--------------------------------------------------------------------
-spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}.
@@ -298,13 +264,8 @@ recv(Socket = #sslsocket{}, Length, Timeout) ->
%% Description: Changes process that receives the messages when active = true
%% or once.
%%--------------------------------------------------------------------
-controlling_process(#sslsocket{pid = Pid, fd = new_ssl}, NewOwner)
- when is_pid(Pid) ->
- ssl_connection:new_user(Pid, NewOwner);
-
-controlling_process(Socket, NewOwner) when is_pid(NewOwner) ->
- ensure_old_ssl_started(),
- ssl_broker:controlling_process(Socket, NewOwner).
+controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) ->
+ ssl_connection:new_user(Pid, NewOwner).
%%--------------------------------------------------------------------
-spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} |
@@ -312,82 +273,31 @@ controlling_process(Socket, NewOwner) when is_pid(NewOwner) ->
%%
%% Description: Returns ssl protocol and cipher used for the connection
%%--------------------------------------------------------------------
-connection_info(#sslsocket{pid = Pid, fd = new_ssl}) ->
- ssl_connection:info(Pid);
+connection_info(#sslsocket{pid = Pid}) ->
+ ssl_connection:info(Pid).
-connection_info(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:connection_info(Socket).
+%%--------------------------------------------------------------------
+-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
+%%
+%% Description: same as inet:peername/1.
+%%--------------------------------------------------------------------
+peername(#sslsocket{pid = Pid}) ->
+ ssl_connection:peername(Pid).
%%--------------------------------------------------------------------
--spec peercert(#sslsocket{}) ->{ok, der_cert()} | {error, reason()}.
+-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
%%
%% Description: Returns the peercert.
%%--------------------------------------------------------------------
-peercert(Socket) ->
- peercert(Socket, []).
-
-peercert(#sslsocket{pid = Pid, fd = new_ssl}, Opts) ->
+peercert(#sslsocket{pid = Pid}) ->
case ssl_connection:peer_certificate(Pid) of
{ok, undefined} ->
{error, no_peercert};
- {ok, BinCert} ->
- decode_peercert(BinCert, Opts);
- {error, Reason} ->
- {error, Reason}
- end;
-
-peercert(#sslsocket{} = Socket, Opts) ->
- ensure_old_ssl_started(),
- case ssl_broker:peercert(Socket) of
- {ok, Bin} ->
- decode_peercert(Bin, Opts);
- {error, Reason} ->
- {error, Reason}
- end.
-
-
-decode_peercert(BinCert, Opts) ->
- PKOpts = [case Opt of ssl -> otp; pkix -> plain end ||
- Opt <- Opts, Opt =:= ssl orelse Opt =:= pkix],
- case PKOpts of
- [Opt] ->
- select_part(Opt, public_key:pkix_decode_cert(BinCert, Opt), Opts);
- [] ->
- {ok, BinCert}
- end.
-
-select_part(otp, Cert, Opts) ->
- case lists:member(subject, Opts) of
- true ->
- TBS = Cert#'OTPCertificate'.tbsCertificate,
- {ok, TBS#'OTPTBSCertificate'.subject};
- false ->
- {ok, Cert}
- end;
-
-select_part(plain, Cert, Opts) ->
- case lists:member(subject, Opts) of
- true ->
- TBS = Cert#'Certificate'.tbsCertificate,
- {ok, TBS#'TBSCertificate'.subject};
- false ->
- {ok, Cert}
+ Result ->
+ Result
end.
%%--------------------------------------------------------------------
--spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
-%%
-%% Description: same as inet:peername/1.
-%%--------------------------------------------------------------------
-peername(#sslsocket{fd = new_ssl, pid = Pid}) ->
- ssl_connection:peername(Pid);
-
-peername(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:peername(Socket).
-
-%%--------------------------------------------------------------------
-spec cipher_suites() -> [erl_cipher_suite()].
-spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()].
@@ -410,9 +320,9 @@ cipher_suites(openssl) ->
%%
%% Description: Gets options
%%--------------------------------------------------------------------
-getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
+getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
ssl_connection:get_opts(Pid, OptionTags);
-getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) ->
+getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) ->
try inet:getopts(ListenSocket, OptionTags) of
{ok, _} = Result ->
Result;
@@ -422,18 +332,15 @@ getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_l
_:_ ->
{error, {eoptions, {inet_options, OptionTags}}}
end;
-getopts(#sslsocket{fd = new_ssl}, OptionTags) ->
- {error, {eoptions, {inet_options, OptionTags}}};
-getopts(#sslsocket{} = Socket, OptionTags) ->
- ensure_old_ssl_started(),
- ssl_broker:getopts(Socket, OptionTags).
+getopts(#sslsocket{}, OptionTags) ->
+ {error, {eoptions, {inet_options, OptionTags}}}.
%%--------------------------------------------------------------------
-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}.
%%
%% Description: Sets options
%%--------------------------------------------------------------------
-setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
+setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
try proplists:expand([{binary, [{mode, binary}]},
{list, [{mode, list}]}], Options0) of
Options ->
@@ -443,7 +350,7 @@ setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list
{error, {eoptions, {not_a_proplist, Options0}}}
end;
-setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) ->
+setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) ->
try inet:setopts(ListenSocket, Options) of
ok ->
ok;
@@ -453,20 +360,17 @@ setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list
_:Error ->
{error, {eoptions, {inet_options, Options, Error}}}
end;
-setopts(#sslsocket{fd = new_ssl}, Options) ->
- {error, {eoptions,{not_a_proplist, Options}}};
-setopts(#sslsocket{} = Socket, Options) ->
- ensure_old_ssl_started(),
- ssl_broker:setopts(Socket, Options).
+setopts(#sslsocket{}, Options) ->
+ {error, {eoptions,{not_a_proplist, Options}}}.
%%---------------------------------------------------------------
-spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}.
%%
%% Description: Same as gen_tcp:shutdown/2
%%--------------------------------------------------------------------
-shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) ->
+shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) ->
CbMod:shutdown(ListenSocket, How);
-shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) ->
+shutdown(#sslsocket{pid = Pid}, How) ->
ssl_connection:shutdown(Pid, How).
%%--------------------------------------------------------------------
@@ -474,25 +378,11 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) ->
%%
%% Description: Same as inet:sockname/1
%%--------------------------------------------------------------------
-sockname(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}) ->
+sockname(#sslsocket{pid = {ListenSocket, _}}) ->
inet:sockname(ListenSocket);
-sockname(#sslsocket{fd = new_ssl, pid = Pid}) ->
- ssl_connection:sockname(Pid);
-
-sockname(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:sockname(Socket).
-
-%%---------------------------------------------------------------
--spec seed(term()) ->term().
-%%
-%% Description: Only used by old ssl.
-%%--------------------------------------------------------------------
-%% TODO: crypto:seed ?
-seed(Data) ->
- ensure_old_ssl_started(),
- ssl_server:seed(Data).
+sockname(#sslsocket{pid = Pid}) ->
+ ssl_connection:sockname(Pid).
%%---------------------------------------------------------------
-spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}.
@@ -548,63 +438,6 @@ format_error(esslconnect) ->
format_error({eoptions, Options}) ->
lists:flatten(io_lib:format("Error in options list: ~p~n", [Options]));
-%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-format_error(ebadsocket) ->
- "Connection not found (internal error).";
-format_error(ebadstate) ->
- "Connection not in connect state (internal error).";
-format_error(ebrokertype) ->
- "Wrong broker type (internal error).";
-format_error(echaintoolong) ->
- "The chain of certificates provided by peer is too long.";
-format_error(ecipher) ->
- "Own list of specified ciphers is invalid.";
-format_error(ekeymismatch) ->
- "Own private key does not match own certificate.";
-format_error(enoissuercert) ->
- "Cannot find certificate of issuer of certificate provided by peer.";
-format_error(enoservercert) ->
- "Attempt to do accept without having set own certificate.";
-format_error(enotlistener) ->
- "Attempt to accept on a non-listening socket.";
-format_error(enoproxysocket) ->
- "No proxy socket found (internal error or max number of file "
- "descriptors exceeded).";
-format_error(enooptions) ->
- "List of options is empty.";
-format_error(enotstarted) ->
- "The SSL application has not been started.";
-format_error(eoptions) ->
- "Invalid list of options.";
-format_error(epeercert) ->
- "Certificate provided by peer is in error.";
-format_error(epeercertexpired) ->
- "Certificate provided by peer has expired.";
-format_error(epeercertinvalid) ->
- "Certificate provided by peer is invalid.";
-format_error(eselfsignedcert) ->
- "Certificate provided by peer is self signed.";
-format_error(esslerrssl) ->
- "SSL protocol failure. Typically because of a fatal alert from peer.";
-format_error(ewantconnect) ->
- "Protocol wants to connect, which is not supported in this "
- "version of the SSL application.";
-format_error(ex509lookup) ->
- "Protocol wants X.509 lookup, which is not supported in this "
- "version of the SSL application.";
-format_error({badcall, _Call}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-format_error({badcast, _Cast}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-format_error({badinfo, _Info}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
format_error(Error) ->
case (catch inet:format_error(Error)) of
"unkknown POSIX" ++ _ ->
@@ -618,16 +451,7 @@ format_error(Error) ->
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
-new_connect(Address, Port, Options, Timeout) when is_list(Options) ->
- try handle_options(Options, client) of
- {ok, Config} ->
- do_new_connect(Address,Port,Config,Timeout)
- catch
- throw:Error ->
- Error
- end.
-
-do_new_connect(Address, Port,
+do_connect(Address, Port,
#config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts,
emulated=EmOpts,inet_ssl=SocketOpts},
Timeout) ->
@@ -647,35 +471,9 @@ do_new_connect(Address, Port,
{error, {eoptions, {inet_options, UserOpts}}}
end.
-old_connect(Address, Port, Options, Timeout) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(connector),
- ssl_broker:connect(Pid, Address, Port, Options, Timeout).
-
-new_listen(Port, Options0) ->
- try
- {ok, Config} = handle_options(Options0, server),
- #config{cb={CbModule, _, _, _},inet_user=Options} = Config,
- case CbModule:listen(Port, Options) of
- {ok, ListenSocket} ->
- {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}};
- Err = {error, _} ->
- Err
- end
- catch
- Error = {error, _} ->
- Error
- end.
-
-old_listen(Port, Options) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(listener),
- ssl_broker:listen(Pid, Port, Options).
-
handle_options(Opts0, _Role) ->
Opts = proplists:expand([{binary, [{mode, binary}]},
{list, [{mode, list}]}], Opts0),
-
ReuseSessionFun = fun(_, _, _, _) -> true end,
DefaultVerifyNoneFun =
@@ -742,7 +540,8 @@ handle_options(Opts0, _Role) ->
secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
debug = handle_option(debug, Opts, []),
- hibernate_after = handle_option(hibernate_after, Opts, undefined)
+ hibernate_after = handle_option(hibernate_after, Opts, undefined),
+ erl_dist = handle_option(erl_dist, Opts, false)
},
CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
@@ -751,7 +550,7 @@ handle_options(Opts0, _Role) ->
depth, cert, certfile, key, keyfile,
password, cacerts, cacertfile, dh, dhfile, ciphers,
debug, reuse_session, reuse_sessions, ssl_imp,
- cb_info, renegotiate_at, secure_renegotiate, hibernate_after],
+ cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
@@ -768,8 +567,6 @@ handle_option(OptionName, Opts, Default) ->
validate_option(versions, Versions) ->
validate_versions(Versions, Versions);
-validate_option(ssl_imp, Value) when Value == new; Value == old ->
- Value;
validate_option(verify, Value)
when Value == verify_none; Value == verify_peer ->
Value;
@@ -811,8 +608,11 @@ validate_option(certfile, Value) when Value == undefined; is_list(Value) ->
validate_option(key, undefined) ->
undefined;
validate_option(key, {KeyType, Value}) when is_binary(Value),
- KeyType == rsa;
- KeyType == dsa ->
+ KeyType == rsa; %% Backwards compatibility
+ KeyType == dsa; %% Backwards compatibility
+ KeyType == 'RSAPrivateKey';
+ KeyType == 'DSAPrivateKey';
+ KeyType == 'PrivateKeyInfo' ->
{KeyType, Value};
validate_option(keyfile, Value) when is_list(Value) ->
Value;
@@ -862,6 +662,9 @@ validate_option(hibernate_after, undefined) ->
undefined;
validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
Value;
+validate_option(erl_dist,Value) when Value == true;
+ Value == false ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {eoptions, {Opt, Value}}}).
@@ -909,7 +712,6 @@ emulated_options() ->
internal_inet_values() ->
[{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
- %%[{packet, ssl},{header, 0},{active, false},{mode,binary}].
socket_options(InetValues) ->
#socket_options{
@@ -970,47 +772,14 @@ cipher_suites(Version, Ciphers0) ->
no_format(Error) ->
lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])).
-
-%% Start old ssl port program if needed.
-ensure_old_ssl_started() ->
- case whereis(ssl_server) of
- undefined ->
- (catch supervisor:start_child(ssl_sup,
- {ssl_server, {ssl_server, start_link, []},
- permanent, 2000, worker, [ssl_server]}));
- _ ->
- ok
- end.
-
-%%%%%%%%%%%%%%%% Deprecated %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-ciphers() ->
- ensure_old_ssl_started(),
- case (catch ssl_server:ciphers()) of
- {'EXIT', _} ->
- {error, enotstarted};
- Res = {ok, _} ->
- Res
- end.
-
-version() ->
- ensure_old_ssl_started(),
- SSLVsn = ?VSN,
- {CompVsn, LibVsn} = case (catch ssl_server:version()) of
- {'EXIT', _} ->
- {"", ""};
- {ok, Vsns} ->
- Vsns
- end,
- {ok, {SSLVsn, CompVsn, LibVsn}}.
-
%% Only used to remove exit messages from old ssl
%% First is a nonsense clause to provide some
%% backward 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_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 72f02a4362..95a5efd6d0 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) ->
block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0,
HashSz, Fragment, Version) ->
- try Fun(Key, IV, Fragment) of
- Text ->
- GBC = generic_block_cipher_from_bin(Text, HashSz),
- case is_correct_padding(GBC, Version) of
- true ->
- Content = GBC#generic_block_cipher.content,
- Mac = GBC#generic_block_cipher.mac,
- CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)},
- {Content, Mac, CipherState1};
- false ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
- end
+ try
+ Text = Fun(Key, IV, Fragment),
+ GBC = generic_block_cipher_from_bin(Text, HashSz),
+ Content = GBC#generic_block_cipher.content,
+ Mac = GBC#generic_block_cipher.mac,
+ CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)},
+ case is_correct_padding(GBC, Version) of
+ true ->
+ {Content, Mac, CipherState1};
+ false ->
+ %% decryption failed or invalid padding,
+ %% intentionally break Content to make
+ %% sure a packet with a an invalid padding
+ %% but otherwise correct data will fail
+ %% the MAC test later
+ {<<16#F0, Content/binary>>, Mac, CipherState1}
+ end
catch
_:_ ->
%% This is a DECRYPTION_FAILED but
@@ -500,14 +505,38 @@ hash_size(md5) ->
hash_size(sha) ->
20.
+%% RFC 5246: 6.2.3.2. CBC Block Cipher
+%%
+%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a
+%% timing attack on CBC padding based on the time required to compute
+%% the MAC. In order to defend against this attack, implementations
+%% MUST ensure that record processing time is essentially the same
+%% whether or not the padding is correct. In general, the best way to
+%% do this is to compute the MAC even if the padding is incorrect, and
+%% only then reject the packet. For instance, if the pad appears to be
+%% incorrect, the implementation might assume a zero-length pad and then
+%% compute the MAC. This leaves a small timing channel, since MAC
+%% performance depends to some extent on the size of the data fragment,
+%% but it is not believed to be large enough to be exploitable, due to
+%% the large block size of existing MACs and the small size of the
+%% timing signal.
+%%
+%% implementation note:
+%% We return the original (possibly invalid) PadLength in any case.
+%% A invalid PadLength will be cought by is_correct_padding/2
+%%
generic_block_cipher_from_bin(T, HashSize) ->
Sz1 = byte_size(T) - 1,
- <<_:Sz1/binary, ?BYTE(PadLength)>> = T,
+ <<_:Sz1/binary, ?BYTE(PadLength0)>> = T,
+ PadLength = if
+ PadLength0 >= Sz1 -> 0;
+ true -> PadLength0
+ end,
CompressedLength = byte_size(T) - PadLength - 1 - HashSize,
<<Content:CompressedLength/binary, Mac:HashSize/binary,
- Padding:PadLength/binary, ?BYTE(PadLength)>> = T,
+ Padding:PadLength/binary, ?BYTE(PadLength0)>> = T,
#generic_block_cipher{content=Content, mac=Mac,
- padding=Padding, padding_length=PadLength}.
+ padding=Padding, padding_length=PadLength0}.
generic_stream_cipher_from_bin(T, HashSz) ->
Sz = byte_size(T),
@@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) ->
#generic_stream_cipher{content=Content,
mac=Mac}.
-is_correct_padding(_, {3, 0}) ->
- true;
-%% For interoperability reasons we do not check the padding in TLS 1.0 as it
-%% is not strictly required and breaks interopability with for instance
-%% Google.
-is_correct_padding(_, {3, 1}) ->
- true;
+%% For interoperability reasons we do not check the padding content in
+%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks
+%% interopability with for instance Google.
+is_correct_padding(#generic_block_cipher{padding_length = Len,
+ padding = Padding}, {3, N})
+ when N == 0; N == 1 ->
+ Len == byte_size(Padding);
%% Padding must be check in TLS 1.1 and after
-is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) ->
- list_to_binary(lists:duplicate(Len, Len)) == Padding.
-
+is_correct_padding(#generic_block_cipher{padding_length = Len,
+ padding = Padding}, _) ->
+ Len == byte_size(Padding) andalso
+ list_to_binary(lists:duplicate(Len, Len)) == Padding.
get_padding(Length, BlockSize) ->
get_padding_aux(BlockSize, Length rem BlockSize).
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index cec81d551b..59b0132ff5 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
@@ -1033,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,
@@ -1044,9 +1044,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo,
catch
error:{badmatch, {error, _} = Error} ->
Error
+ end;
+
+start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts,
+ User, {CbModule, _,_, _} = CbInfo,
+ Timeout) ->
+ try
+ {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket,
+ Opts, User, CbInfo]),
+ {ok, SslSocket} = socket_control(Socket, Pid, CbModule),
+ ok = handshake(SslSocket, Timeout),
+ {ok, SslSocket}
+ catch
+ error:{badmatch, {error, _} = Error} ->
+ Error
end.
ssl_init(SslOpts, Role) ->
+
+ init_manager_name(SslOpts#ssl_options.erl_dist),
+
{ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role),
PrivateKey =
init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
@@ -1054,6 +1071,10 @@ ssl_init(SslOpts, Role) ->
DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
{ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}.
+init_manager_name(false) ->
+ put(ssl_manager, ssl_manager);
+init_manager_name(true) ->
+ put(ssl_manager, ssl_manager_dist).
init_certificates(#ssl_options{cacerts = CaCerts,
cacertfile = CACertFile,
@@ -1105,18 +1126,38 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) ->
{ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle),
[PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List,
PKey =:= 'RSAPrivateKey' orelse
- PKey =:= 'DSAPrivateKey'],
- public_key:pem_entry_decode(PemEntry, Password)
+ PKey =:= 'DSAPrivateKey' orelse
+ PKey =:= 'PrivateKeyInfo'
+ ],
+ private_key(public_key:pem_entry_decode(PemEntry, Password))
catch
Error:Reason ->
handle_file_error(?LINE, Error, Reason, KeyFile, ekeyfile,
erlang:get_stacktrace())
end;
+%% First two clauses are for backwards compatibility
init_private_key(_,{rsa, PrivateKey}, _, _,_) ->
- public_key:der_decode('RSAPrivateKey', PrivateKey);
+ init_private_key('RSAPrivateKey', PrivateKey);
init_private_key(_,{dsa, PrivateKey},_,_,_) ->
- public_key:der_decode('DSAPrivateKey', PrivateKey).
+ init_private_key('DSAPrivateKey', PrivateKey);
+init_private_key(_,{Asn1Type, PrivateKey},_,_,_) ->
+ private_key(init_private_key(Asn1Type, PrivateKey)).
+
+init_private_key(Asn1Type, PrivateKey) ->
+ public_key:der_decode(Asn1Type, PrivateKey).
+
+private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'rsaEncryption'},
+ privateKey = Key}) ->
+ public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key));
+
+private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'},
+ privateKey = Key}) ->
+ public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key));
+private_key(Key) ->
+ Key.
-spec(handle_file_error(_,_,_,_,_,_) -> no_return()).
handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) ->
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_int.hrl b/lib/ssl/src/ssl_int.hrl
deleted file mode 100644
index 3686deffce..0000000000
--- a/lib/ssl/src/ssl_int.hrl
+++ /dev/null
@@ -1,99 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-
-%% op codes commands are in capital and reply codes in lower case
-
--define(CONNECT, 1).
--define(CONNECT_WAIT, 2).
--define(CONNECT_REP, 3).
--define(CONNECT_ERR, 4).
-
--define(TERMINATE, 5).
--define(CLOSE, 6).
-
--define(LISTEN, 7).
--define(LISTEN_REP, 8).
--define(LISTEN_ERR, 9).
-
--define(TRANSPORT_ACCEPT, 10).
--define(NOACCEPT, 11).
--define(TRANSPORT_ACCEPT_REP, 12).
--define(TRANSPORT_ACCEPT_ERR, 13).
-
--define(FROMNET_CLOSE, 14).
-
--define(CONNECT_SYNC_ERR, 15).
--define(LISTEN_SYNC_ERR, 16).
-
--define(PROXY_PORT, 23).
--define(PROXY_JOIN, 24).
--define(PROXY_JOIN_REP, 25).
--define(PROXY_JOIN_ERR, 26).
-
--define(SET_SOCK_OPT, 27).
--define(IOCTL_OK, 28).
--define(IOCTL_ERR, 29).
-
--define(GETPEERNAME, 30).
--define(GETPEERNAME_REP, 31).
--define(GETPEERNAME_ERR, 32).
-
--define(GETSOCKNAME, 33).
--define(GETSOCKNAME_REP, 34).
--define(GETSOCKNAME_ERR, 35).
-
--define(GETPEERCERT, 36).
--define(GETPEERCERT_REP, 37).
--define(GETPEERCERT_ERR, 38).
-
--define(GETVERSION, 39).
--define(GETVERSION_REP, 40).
-
--define(SET_SEED, 41).
-
--define(GETCONNINFO, 42).
--define(GETCONNINFO_REP, 43).
--define(GETCONNINFO_ERR, 44).
-
--define(SSL_ACCEPT, 45).
--define(SSL_ACCEPT_REP, 46).
--define(SSL_ACCEPT_ERR, 47).
-
--define(DUMP_CMD, 48).
--define(DEBUG_CMD, 49).
--define(DEBUGMSG_CMD, 50).
-
-%% --------------
-
--define(SSLv2, 1).
--define(SSLv3, 2).
--define(TLSv1, 4).
-
-
-%% Set socket options codes 'SET_SOCK_OPT'
--define(SET_TCP_NODELAY, 1).
-
--define(DEF_BACKLOG, 128).
-
--define(DEF_TIMEOUT, 10000).
-
--record(sslsocket, { fd = nil, pid = nil}).
-
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 6bf1edc452..18cfcdcd68 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -24,6 +24,9 @@
-include_lib("public_key/include/public_key.hrl").
+%% Looks like it does for backwards compatibility reasons
+-record(sslsocket, {fd = nil, pid = nil}).
+
-type reason() :: term().
-type reply() :: term().
-type msg() :: term().
@@ -98,10 +101,12 @@
renegotiate_at,
secure_renegotiate,
debug,
- hibernate_after % undefined if not hibernating,
+ hibernate_after,% undefined if not hibernating,
% or number of ms of inactivity
% after which ssl_connection will
% go into hibernation
+ %% This option should only be set to true by inet_tls_dist
+ erl_dist = false
}).
-record(socket_options,
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 725a085d1f..dcf310c535 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -27,7 +27,7 @@
-include("ssl_internal.hrl").
%% Internal application API
--export([start_link/1,
+-export([start_link/1, start_link_dist/1,
connection_init/2, cache_pem_file/2,
lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4,
server_session_id/4,
@@ -66,10 +66,20 @@
%%--------------------------------------------------------------------
-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}.
%%
-%% Description: Starts the server
+%% Description: Starts the ssl manager that takes care of sessions
+%% and certificate caching.
%%--------------------------------------------------------------------
start_link(Opts) ->
- gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []).
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []).
+
+%%--------------------------------------------------------------------
+-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts a special instance of the ssl manager to
+%% be used by the erlang distribution. Note disables soft upgrade!
+%%--------------------------------------------------------------------
+start_link_dist(Opts) ->
+ gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []).
%%--------------------------------------------------------------------
-spec connection_init(string()| {der, list()}, client | server) ->
@@ -166,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 =
@@ -376,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
@@ -399,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).
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_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_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.