%%% BEGIN openflax/tcp.erl %%%
%%%
%%% openflax - Open Source web server for Erlang/OTP
%%% Copyright (c)2004 Cat's Eye Technologies.  All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions
%%% are met:
%%%
%%%   Redistributions of source code must retain the above copyright
%%%   notice, this list of conditions and the following disclaimer.
%%%
%%%   Redistributions in binary form must reproduce the above copyright
%%%   notice, this list of conditions and the following disclaimer in
%%%   the documentation and/or other materials provided with the
%%%   distribution.
%%%
%%%   Neither the name of Cat's Eye Technologies nor the names of its
%%%   contributors may be used to endorse or promote products derived
%%%   from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
%%% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
%%% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
%%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
%%% DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
%%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
%%% OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
%%% PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
%%% OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
%%% ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
%%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
%%% OUT OF THE USE OF THIS SOFTWARE, EVEN IF AsDVISED OF THE
%%% POSSIBILITY OF SUCH DAMAGE. 

%% @doc TCP/IP socket library for OpenFlax.
%%
%% @end

-module(openflax.tcp).
-vsn('$Id: tcp.erl 31 2004-04-23 07:00:11Z catseye $').
-author('catseye@catseye.mb.ca').
-copyright('Copyright (c)2004 Cat`s Eye Technologies. All rights reserved.').

-export([server/4]).
-export([get_iface_ip_addr/1]).

-import(gen_tcp).
-import(inet).
-import(inet_udp).
-import(prim_inet).
-import(io).

%% @spec server(Fun::fun(), Port::integer(), Opts::[option()],
%%         MaxCon::integer()) -> pid() | {error, reason()}
%% @doc Implements a generic TCP/IP socket server.
%% Opens a socket with the given options on the given port and spawns
%% <code>Fun(Socket)</code> to handle each incoming connection, up to
%% the specified maximum number of connections.

server(Fun, Port, Options, MaxCon) ->
  {ok, ListenSocket} = gen_tcp:listen(Port, Options),
  spawn_link(fun() ->
    server_setup(Fun, ListenSocket, Port, Options, MaxCon)
  end).

%% @spec server_setup(Fun::fun(), LSock::listen_socket(), Port::integer(),
%%         Opts::[option()], MaxCon::integer()) -> never_returns
%% @doc Used by <code>server/6</code> to handle the listen socket.

server_setup(Fun, ListenSocket, Port, Options, 0) ->
  % When the maximum number of connections has been reached, wait
  % until a socket connection dies before starting any more accepts.

  receive
    {'EXIT', _Pid, _Reason} ->
      server_setup(Fun, ListenSocket, Port, Options, 1)
  end;

server_setup(Fun, ListenSocket, Port, Options, MaxCon) ->
  % By setting the process flag trap_exit to true, we will recieve
  % {'EXIT', Pid, Reason} messages for any linked processes that die

  process_flag(trap_exit, true),

  % Therefore, this call is not a spawn_link because we only want to
  % get exit messages when the user socket handlers die

  Looper = self(),
  Accepter = spawn(fun() -> asynch_accept(Looper, ListenSocket) end),
  server_loop(Fun, ListenSocket, Port, Options, MaxCon, Accepter).

%% @spec server_loop(Fun::fun(), LSock::listen_socket(), Port::integer(),
%%       Opts::[option()], MaxCon::integer(), Accepter::pid()) -> never_returns
%% @doc Called by <code>server_setup/5</code> to handle the listen socket.
%% This function waits around for something to happen:
%% either for a message to arrive from the previous <code>asynch_accept/2</code>
%% (meaning there is now one more connection), or for the exit signal of an
%% existing socket process (meaning there is now one less connection.)  In the
%% former case, a new asynchronous <code>accept</code> call is set up by
%% looping back to <code>server_setup/5</code>.

server_loop(Fun, LSock, Port, Options, MaxCon, Accepter) ->
  receive
    {Accepter, {ok, Socket}} ->
      {ok, {RemoteAddress, _}} = inet:peername(Socket),
      Pid = spawn_link(fun() ->
        case catch Fun(Socket, RemoteAddress) of
	  {'EXIT', Reason} ->
	    io:fwrite("process ~p died unexpectedly: ~p~n", [self(), Reason]),
	    exit(Reason);
	  _ ->
	    exit(normal)
	end
      end),
      gen_tcp:controlling_process(Socket, Pid),
      server_setup(Fun, LSock, Port, Options, MaxCon - 1);
    {Accepter, {error, closed}} ->
      server_setup(Fun, LSock, Port, Options, MaxCon);
    {Accepter, {error, _Reason}} ->
      server_setup(Fun, LSock, Port, Options, MaxCon);
    {'EXIT', _Pid, _Reason} ->
      server_loop(Fun, LSock, Port, Options, MaxCon + 1, Accepter)
  end.

%% @spec asynch_accept(Parent::pid(), LSock::listen_socket()) -> never_returns
%% @doc Used by <code>server_loop/6</code> to handle the listen socket.
%% This function waits for a connection using <code>gen_tcp:accept/1</code>
%% and notifies the parent process which spawned it when a connection happens,
%% allowing the parent to process other messages in the meantime.

asynch_accept(Parent, ListenSocket) ->
  Result = gen_tcp:accept(ListenSocket),
  case Result of
    {ok, Socket} ->
      gen_tcp:controlling_process(Socket, Parent);
    _ ->
      ok
  end,
  Parent ! {self(), Result}.

%% @spec get_iface_ip_addr(Interface::string()) -> ip_addr()
%% @doc Acquires the IP address of a given interface.
%% Thanks to Samuel Rivas for this code.

get_iface_ip_addr(Interface) ->
  {ok, Socket} = inet_udp:open(0, []),
  {ok, [{addr, Address}]} = prim_inet:ifget(Socket, Interface, [addr]),
  inet_udp:close(Socket),
  Address.

%%% END of openflax/tcp.erl %%%