(*
 * <COPYRIGHT>
 * Copyright 2003 Gerd Stolpmann
 *
 * <GPL>
 * This file is part of WTimer.
 *
 * WTimer is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * WTimer 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with WDialog; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 * </>
 *)

(* $Id: main_ajp.ml,v 1.4 2003/03/23 11:59:14 gerd Exp $
 * ----------------------------------------------------------------------
 *
 *)

open Wd_run_jserv
open Netcgi_jserv
open Netcgi_jserv_app

(* WDialog processing: *)
let start foreground =
  let config = Get_config.parse() in

  let ajp_processes =
    Get_config.int_option config "ajp-processes" in

  let ajp_backlog =
    Get_config.int_option config "ajp-backlog" in

  let db_timeout =
    Get_config.int_option config "database-timeout" in

  let ajp_port =
    Get_config.int_option config "ajp-port" in

  let ajp_bindaddress =
    let s = Get_config.option config "ajp-bindaddress" in
    if s = "*" then 
      Unix.inet_addr_any
    else
      try
	Unix.inet_addr_of_string s
      with
	  _ ->
	    try 
	      (Unix.gethostbyname s).Unix.h_addr_list.(0)
	    with
		Not_found ->
		  failwith ("Cannot resolve " ^ s)
  in

  let ajp_allowhost =
    List.map
      (fun v ->
	 ("security.allowHost", v))
      (Get_config.list_option config "ajp-allowhost") in

  let ajp_https =
    [ "ocamlnet.https", 
      if Get_config.bool_option config "ajp-https" then "true" else "false" 
    ] in

  let ajp_mount_point =
    [ "jakarta.servletSubString",
      Get_config.option config "ajp-mount-point" 
    ] in

  let ajp_pid_file = Get_config.option config "ajp-pid-file" in

  let rh =
    create_request_handler
      ~uifile:(Filename.concat Const.ui_dir "wtimer.ui")
      ~charset:Const.internal_charset
      ~session_manager:(new Db.Session.db_session_manager Init.db)
      ~error_page:(fun ch err -> !Init.print_error ch err)
      ~reg:(Init.reg config)
      () in

  let server = 
    if ajp_processes = 0 then
      `Forking(max_int, ["wtimer", rh])
    else
      `Process_pool(ajp_processes, ["wtimer",rh]) in

  let ajp_config = 
    { std_config with
	js_backlog = ajp_backlog;
	js_init_process = 
	  (fun () -> 
	     (* Make sure the DB connection is not yet established. Every
	      * subprocess should create its own connection.
	      *)
	     assert(not(Db.Connection.is_connected Init.db));
	  );
	js_fini_process = 
	  (fun () -> 
	     (* Close the DB connection, if any *)
	     Db.Connection.unbind Init.db);
	js_idle_worker =
	  (fun () ->
	     (* Close the DB connection if idle for too long *)
	     Db.Connection.close_after_timeout Init.db db_timeout)	     
    } in

  let props =
    ajp_allowhost @ ajp_https in

  if not foreground then begin
    (* Put this process into background *)
    let ajp_pid_out = open_out ajp_pid_file in
    match Unix.fork() with
	0 ->
	  ( match Unix.fork() with
		0 ->
		  (* Usual daemonization... *)
		  ignore(Unix.setsid());
		  Unix.close Unix.stdin;
		  ignore(Unix.openfile "/dev/null" [Unix.O_RDONLY] 0);
		  Unix.close Unix.stdout;
		  ignore(Unix.openfile "/dev/null" [Unix.O_WRONLY] 0);
		  Unix.close Unix.stderr;
		  ignore(Unix.openfile "/dev/null" [Unix.O_WRONLY] 0);
		  Unix.chdir "/";
		  let pid = Unix.getpid() in
		  output_string ajp_pid_out (string_of_int pid);
		  output_string ajp_pid_out "\n";
		  close_out ajp_pid_out;
	      | _ ->
		  exit 0
	  )
      | _ ->
	  exit 0
  end;

  Netcgi_jserv_app.logger := (fun _ msg -> Init.log_error msg);
  
  (* Set up signal handlers. SIGPIPE is ignored, so broken pipes are reported
   * by the system call as EPIPE, and no longer cause program termination.
   * SIGCHLD is set to an empty handler. The effect is that whenever a
   * child terminates, the next blocking system call will return EINTR.
   * Note that for SIGCHLD an empty handler has a different meaning than
   * ignoring the signal!
   *)
  ignore(Sys.signal Sys.sigpipe Sys.Signal_ignore);
  ignore(Sys.signal Sys.sigchld (Sys.Signal_handle (fun _ -> ())));

  (* This signal terminates the daemon: *)
  ignore(Sys.signal 
	   Sys.sigterm 
	   (Sys.Signal_handle (fun _ -> raise Netcgi_jserv.Signal_shutdown)));

  run ~config:ajp_config server `Ajp_1_2 props None ajp_bindaddress ajp_port;

  if not foreground then begin
    try Sys.remove ajp_pid_file with _ -> ()
  end
;;


let foreground = ref false;;

let print_version() =
  Printf.printf "wtimer version %s\n" Const.version;
  flush stdout;
  exit 0
;;


Arg.parse
    [ "-version", Arg.Unit print_version,
               "           Print program version and exit";
      "-foreground", Arg.Set foreground,
                  "        Run in the foreground, and do not write pid file";
    ]
    (fun _ -> raise(Arg.Bad "Unexpected argument"))
    "usage: wtimerd [options]" ;;

start !foreground;;

(* ======================================================================
 * History:
 * 
 * $Log: main_ajp.ml,v $
 * Revision 1.4  2003/03/23 11:59:14  gerd
 * 	GPL
 *
 * Revision 1.3  2003/02/04 01:42:40  gerd
 * 	The code does no longer use signals to get rid of inactive
 * database connections. Instead, new features of ocamlnet are used
 * (js_idle_worker).
 *
 * Revision 1.2  2003/02/03 01:28:59  gerd
 * 	Continued.
 *
 * Revision 1.1  2003/01/28 01:06:56  gerd
 * 	Initial revision.
 *
 * 
 *)