aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ssl/src/ssl_server.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/ssl/src/ssl_server.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/ssl/src/ssl_server.erl')
-rw-r--r--lib/ssl/src/ssl_server.erl1378
1 files changed, 1378 insertions, 0 deletions
diff --git a/lib/ssl/src/ssl_server.erl b/lib/ssl/src/ssl_server.erl
new file mode 100644
index 0000000000..b66e20a397
--- /dev/null
+++ b/lib/ssl/src/ssl_server.erl
@@ -0,0 +1,1378 @@
+%%
+%% %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.