From: Claudio Sacerdoti Coen Date: Thu, 15 May 2003 16:51:37 +0000 (+0000) Subject: Several changes: X-Git-Tag: submitted~43 X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=commitdiff_plain;h=39c8c5c53680cd374a3eb76993a592cf29bb92ba 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 450449ec4..0a0294c41 100644 --- 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 ^ "
" ^ 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 "
...
" else "
") ^ - 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 "
...
" else "
") ^ + 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