(* * <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 1 2004-01-14 14:12:16Z gerd $ * ---------------------------------------------------------------------- * *) 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;;