(***********************************************************************)
(*                                                                     *)
(*                          OCamlP3l                                   *)
(*                                                                     *)
(* (C) 2004-2007                                                       *)
(*             Roberto Di Cosmo (dicosmo@dicosmo.org)                  *)
(*             Zheng Li (zli@lip6.fr)                                  *)
(*             Pierre Weis (Pierre.Weis@inria.fr)                      *)
(*             Francois Clement (Francois.Clement@inria.fr)            *)
(*                                                                     *)
(* Based on original Ocaml P3L System                                  *)
(* (C) 1997 by                                                         *)
(*             Roberto Di Cosmo (dicosmo@ens.fr)                       *)
(*             Marco Danelutto (marcod@di.unipi.it)                    *)
(*             Xavier Leroy  (Xavier.Leroy@inria.fr)                   *)
(*             Susanna Pelagatti (susanna@di.unipi.it)                 *)
(*                                                                     *)
(* This program is free software; you can redistribute it and/or       *)
(* modify it under the terms of the GNU Library General Public License *)
(* as published by the Free Software Foundation; either version 2      *)
(* of the License, or (at your option) any later version.              *)
(*                                                                     *)
(* This program is distributed in the hope that it will be useful,     *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
(* GNU Library General Public License for more details.                *)
(*                                                                     *)
(***********************************************************************)

(* $Id: server_process.ml,v 1.4 2007-01-23 15:50:04 weis Exp $ *)

open Printf;;
open Unix;;
open Basedefs;;

(* An output function for debugging *)

let debug ?(mask = 1) f =
  if !dbg && mask land !dbgmask > 0 then (f (); print_newline());;

(* Print context for debugging *)
let context chan =
  fprintf chan "PID %d (on %s)" (getpid()) (gethostname());;

let timedcontext chan =
  fprintf chan "PID %d(%f) [on %s]" (getpid()) (gettimeofday()) (gethostname());;

(* This function makes a reference local to the process/thread *)

let mklocalref v = let r = ref v in (fun () -> !r),(fun v -> r:= v);;  (* id on processes *)

(* Establish a server on an input socket, keeping track of sons and exiting when no sons left *)

(* WARNING: the usage of inet_addr_any is dangerous: on a machine with several interfaces, this
   does not necessarily sets up the server on the network we want *)

let establish_smart_server servfun =
  let sock = socket PF_INET SOCK_STREAM 0 in
  begin
    match !dynport with
      true -> bind sock (ADDR_INET(inet_addr_any,0));
        let port = match Unix.getsockname sock with 
	  | ADDR_INET(_,x) -> x | _ -> assert false
        in printf "dynport=%4d\n" port; print_newline()
    | false ->  bind sock (ADDR_INET(inet_addr_any,p3lport))
  end;
  listen sock 3;
  let child_count = ref 0 in
  let rec reap_children signo =
    let (pid, status) = waitpid [WNOHANG] (-1) in
    if pid <> 0 then begin
	debug (fun () -> printf "%t: PID %d terminated" context pid; print_newline());
      decr child_count;
      if !child_count = 0 then begin
        debug (fun () -> printf "%t: no more children, exiting" context; print_newline());
        exit 0
      end;
      reap_children signo
    end in
  let _ = Sys.signal Sys.sigchld (Sys.Signal_handle reap_children) in ();
  while true do
    try
      let (s, caller) = accept sock in
      incr child_count;
      if fork() = 0 then begin
        servfun s caller;
        begin
	  try
	    debug(fun () -> printf "server_process: closing channel %s -> %s.\n" (name_of_descr ~peer:false s) (name_of_descr s));
	    Unix.close s
	  with _ -> debug(fun () -> printf "server_process: channel already closed!");  (); (* protect in case the server already closed the channel! *)
	end;
        exit 0
      end
    with Unix_error(EINTR, _, _) -> debug (fun () -> printf "server_process: received EINTR")
  done;;

let spawn func arg =
  let i = Unix.fork () in
  if i = 0 then (func arg; exit 0);;