The R13B03 release.OTP_R13B03

1 files changed, 1188 insertions, 0 deletions

diff --git a/lib/ssl/src/ssl_broker.erl b/lib/ssl/src/ssl_broker.erl
new file mode 100644
index 0000000000..178fb5fcb9
--- /dev/null
+++ b/lib/ssl/src/ssl_broker.erl
@@ -0,0 +1,1188 @@
+%%
+%% %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 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.