debian release 0.3.99-1

[helm.git] / helm / uwobo / src / ocaml / uwobo.ml

diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml
index 72f1c08e76cc30a6a8571963497edc432f8566bc..bea96a2a09b1cf1d61af184e658b9ddea5825138 100644 (file)
--- a/helm/uwobo/src/ocaml/uwobo.ml
+++ b/helm/uwobo/src/ocaml/uwobo.ml
@@ -31,11 +31,11 @@ open Uwobo_common;;
 
  (* debugging settings *)
 let debug = false;;
-let debug_level = `Debug;;
+let debug_level = `Notice;;
 let debug_print s = if debug then prerr_endline s;;
 Http_common.debug := false;;
 let logfile = Some "uwobo.log";;  (* relative to execution dir *)
-let logfile_perm = 0o644;;
+let logfile_perm = 0o640;;
 
   (* other settings *)
 let daemon_name = "UWOBO OCaml";;
@@ -231,11 +231,21 @@ let main () =
     (* (2) stylesheets list *)
   let styles = new Uwobo_styles.styles in
     (* (3) clean up actions *)
+  let last_process = ref true in
+  let http_child = ref None in
   let die_nice () = (** at_exit callback *)
-    syslogger#log `Notice (sprintf "%s is terminating, bye!" daemon_name);
-    syslogger#disable;
-    close_out logger_outchan
+    if !last_process then begin
+      (match !http_child with
+      | None -> ()
+      | Some pid -> Unix.kill pid Sys.sigterm);
+      syslogger#log `Notice (sprintf "%s is terminating, bye!" daemon_name);
+      syslogger#disable;
+      close_out logger_outchan
+    end
   in
+  at_exit die_nice;
+  ignore (Sys.signal Sys.sigterm
+    (Sys.Signal_handle (fun _ -> raise Sys.Break)));
   syslogger#log `Notice
     (sprintf "%s started and listening on port %d" daemon_name port);
   syslogger#log `Notice (sprintf "current directory is %s" (Sys.getcwd ()));
@@ -244,7 +254,8 @@ let main () =
     let (cmd_pipe_exit, cmd_pipe_entrance) = Unix.pipe () in
     let (res_pipe_exit, res_pipe_entrance) = Unix.pipe () in
     match Unix.fork () with
-    | child when child > 0 -> (* (5) parent: listen on cmd pipe for updates *)
+    | child when child > 0 -> (* (4) parent: listen on cmd pipe for updates *)
+        http_child := Some child;
         let stop_http_daemon () =  (* kill child *)
           debug_print (sprintf "Grandparent: killing pid %d" child);
           Unix.kill child Sys.sigterm;  (* kill child ... *)
@@ -252,7 +263,6 @@ let main () =
           ignore (Unix.waitpid [] child);  (* ... and its zombie *)
           debug_print "Grandparent: murder completed!!!"
         in
-        at_exit die_nice;
         Unix.close cmd_pipe_entrance;
         Unix.close res_pipe_exit;
         let cmd_pipe = Unix.in_channel_of_descr cmd_pipe_exit in
@@ -315,9 +325,10 @@ let main () =
         with Restart_HTTP_daemon ->
           close_in cmd_pipe;  (* these calls close also fds *)
           close_out res_pipe;)
-    | 0 ->  (* (6) child: serve http requests *)
+    | 0 ->  (* (5) child: serve http requests *)
         Unix.close cmd_pipe_exit;
         Unix.close res_pipe_entrance;
+        last_process := false;
         let cmd_pipe = Unix.out_channel_of_descr cmd_pipe_entrance in
         let res_pipe = Unix.in_channel_of_descr res_pipe_exit in
         debug_print "Starting HTTP daemon ...";