Several changes:

1. the UWOBO_LOG_FILE environment variable semantics changed. It is now
   used in the following way: $UWOBO_LOG_FILE.pid.log
2. when the log file can not be opened, UWOBO used to crash. Instead,
   it now goes on and a nice error message is printed on the stderr
   (but, unfortunately, it is not given back to the user, since the
   error is raised in a new process and it can not be read back from
   the logfile!)

diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 450449ec41d2d27db3054ed9cd0f7ba653d7a796..0a0294c41a051828d528f0eabf0f7f688283b1aa 100644 (file)
--- a/helm/uwobo/uwobo.ml
+++ b/helm/uwobo/uwobo.ml
@@ -37,11 +37,11 @@ Http_common.debug := false ;;
 
   (* other settings *)
 let daemon_name = "UWOBO OCaml" ;;
-let default_log_base_file = "log/uwobo_" ;; (* relative to execution dir *)
-let default_log_extension = ".log" ;;
+let default_log_base_file = "log/uwobo" ;; (* relative to execution dir *)
+let log_extension = ".log" ;;
 let default_port = 58080 ;;
 let port_env_var = "UWOBO_PORT" ;;
-let log_env_var = "UWOBO_LOG_FILE" ;;
+let log_env_var = "UWOBO_LOG_FILE" ;; (* The extension _pid.log will be added *)
 let default_media_type = "text/html" ;;
 let default_encoding = "utf8" ;;
 let port =
@@ -53,14 +53,16 @@ let port =
      prerr_endline "Warning: invalid port number" ;
      exit (-1)
 ;;
-let logfilename_of_port ~use_log_env_var port =
- (try
-   if use_log_env_var then Sys.getenv log_env_var else raise Not_found
+let logfilename_of_port port =
+ let basename =
+  try
+   Sys.getenv log_env_var
   with
-   Not_found ->
-    default_log_base_file ^ (string_of_int port) ^ default_log_extension)
+   Not_found -> default_log_base_file
+ in
+  basename ^ "_" ^ string_of_int port ^ log_extension
 ;;
-let logfile = logfilename_of_port true port;;
+let logfile = logfilename_of_port port;;
 let logfile_perm = 0o640 ;;
 
 let respond_html body outchan =
@@ -216,24 +218,27 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
   ) ;
   match Unix.fork () with
      0 ->
-      (* 1. We close all the open pipes to avoid duplicating them *)
-      Unix.close (Unix.descr_of_out_channel cmd_pipe) ;
-      Unix.close (Unix.descr_of_in_channel res_pipe) ;
-      Unix.close (Unix.descr_of_out_channel outchan) ;
-      (* 2. We redirect stdout and stderr to the logfile *)
-      Unix.close Unix.stdout ;
-      assert
-       (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
-         0o664 = Unix.stdout) ;
-      Unix.close Unix.stderr ;
-      assert
-       (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
-         0o664 = Unix.stderr) ;
-      prerr_endline "***** Starting a new session" ;
-      (* 3. We exec a new copy of uwobo *)
-      Unix.execve Sys.executable_name [||] environment ; 
-      (* It should never reach this point *)
-      assert false
+       Unix.handle_unix_error
+        (function () ->
+          (* 1. We close all the open pipes to avoid duplicating them *)
+          Unix.close (Unix.descr_of_out_channel cmd_pipe) ;
+          Unix.close (Unix.descr_of_in_channel res_pipe) ;
+          Unix.close (Unix.descr_of_out_channel outchan) ;
+          (* 2. We redirect stdout and stderr to the logfile *)
+          Unix.close Unix.stdout ;
+          assert
+           (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
+             0o664 = Unix.stdout) ;
+          Unix.close Unix.stderr ;
+          assert
+           (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
+             0o664 = Unix.stderr) ;
+          prerr_endline "***** Starting a new session" ;
+          (* 3. We exec a new copy of uwobo *)
+          Unix.execve Sys.executable_name [||] environment ; 
+          (* It should never reach this point *)
+          assert false
+        ) ()
    | child when child > 0 ->
       (* let's check if the new UWOBO started correctly *)
       Unix.sleep 5 ;
@@ -276,38 +281,38 @@ let callback
     | "/newsession" ->
         let logger = new Uwobo_logger.processingLogger () in
         let port = int_of_string (req#param "port") in
-                               let logfile = logfilename_of_port false port in
+        let logfile = logfilename_of_port port in
         (try
           start_new_session cmd_pipe res_pipe outchan port logfile ;
           logger#log (sprintf "New session started: port = %d" port) ;
           respond_html logger#asHtml outchan
          with
-                                               Failure "int_of_string" ->
-                                                logger#log (sprintf "Invalid port number") ;
-                                                respond_html logger#asHtml outchan
-                                 | Failure "Port already in use" ->
-                                                Uwobo_common.return_error "port already in use" outchan
-                                 | Failure "Connection refused" ->
-                                                let log = ref [] in
-                                                       (try
-                                                               let ch = open_in logfile in
-                                                                while true do log := (input_line ch ^ "\n") :: !log ; done
-                                                        with
-                                                                       Sys_error _
-                                                               | End_of_file -> ()
-                                                       ) ;
-                                                       let rec get_last_lines acc =
-                                                        function
-                                                                       (n,he::tl) when n > 0 ->
+            Failure "int_of_string" ->
+             logger#log (sprintf "Invalid port number") ;
+             respond_html logger#asHtml outchan
+          | Failure "Port already in use" ->
+             Uwobo_common.return_error "port already in use" outchan
+          | Failure "Connection refused" ->
+             let log = ref [] in
+              (try
+                let ch = open_in logfile in
+                 while true do log := (input_line ch ^ "\n") :: !log ; done
+               with
+                  Sys_error _
+                | End_of_file -> ()
+              ) ;
+              let rec get_last_lines acc =
+               function
+                  (n,he::tl) when n > 0 ->
                     get_last_lines (he ^ "<br />" ^ acc) (n-1,tl)
-                                                               | _ -> acc
-                                                       in
-                                                        (* we just show the last 10 lines of the log file *)
-                                                        let msg =
-                                                               (if List.length !log > 0 then "<br />...<br />" else "<br />") ^
-                                                                get_last_lines "" (10,!log)
-                                                        in
-                                                   Uwobo_common.return_error "daemon not initialized"
+                | _ -> acc
+              in
+               (* we just show the last 10 lines of the log file *)
+               let msg =
+                (if List.length !log > 0 then "<br />...<br />" else "<br />") ^
+                 get_last_lines "" (10,!log)
+               in
+                Uwobo_common.return_error "daemon not initialized"
                  ~body:msg outchan)
     | "/remove" ->
           let cmd = sprintf "remove %s" (req#param "keys") in