diff options
Diffstat (limited to 'lib/ssl/src/ssl_broker.erl')
| -rw-r--r-- | lib/ssl/src/ssl_broker.erl | 1188 |
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. |