%%
%% %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.