(** raised when a client timeouts *)
exception Timeout;;

let backlog = 10;;

  (** if timeout is given (Some _) @return a new callback which establish
  timeout_callback as callback for signal Sys.sigalrm and register an alarm
  (expiring after timeout seconds) before invoking the real callback given. If
  timeout is None, callback is returned unchanged. *)
let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback =
  match timeout with
  | None -> callback
  | Some timeout -> (* wrap callback setting an handler for ALRM signal and an
                    alarm that ring after timeout seconds *)
      (fun inchan outchan ->
        ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle ~timeout_callback));
        ignore (Unix.alarm timeout);
        callback inchan outchan)

let init_socket_and_callback sockaddr callback timeout =
  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  Unix.setsockopt suck Unix.SO_REUSEADDR true;
  Unix.bind suck sockaddr;
  Unix.listen suck backlog;
  let timeout_callback signo =
    if signo = Sys.sigalrm then
      raise Timeout
  in
  let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in
  (suck, callback)

  (** tcp_server which use Unix.establish_server which in turn forks a child for
  each request *)
let ocaml_builtin ~sockaddr ~timeout callback =
  let timeout_callback signo =
    if signo = Sys.sigalrm then
      exit 2
  in
  Unix.establish_server
    (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback)
    sockaddr

  (** tcp_server which doesn't fork, requests are server sequentially and in the
  same address space of the calling process *)
let simple ~sockaddr ~timeout callback =
  let (suck, callback) = init_socket_and_callback sockaddr callback timeout in
  while true do
    let (client, _) = Unix.accept suck in
      (* client is now connected *)
    let (inchan, outchan) =
      (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
    in
    (try
      callback inchan outchan;
      ignore (Unix.alarm 0) (* reset alarm *)
    with Timeout -> ());
    close_out outchan (* this close also inchan, because socket is the same *)
  done

  (** tcp_server which creates a new thread for each request to be served *)
let thread ~sockaddr ~timeout callback =
  let (suck, callback) = init_socket_and_callback sockaddr callback timeout in
  let callback (i, o) =
    try
      callback i o;
      close_out o
    with
    | Timeout -> close_out o
    | e ->
        close_out o;
        raise e
  in
  while true do
    let (client, _) = Unix.accept suck in
      (* client is now connected *)
    let (inchan, outchan) =
      (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
    in
    Http_threaded_tcp_server.serve callback (inchan, outchan)
  done