let debug_print s = if debug then prerr_endline s ;;
Http_common.debug := false ;;
+
+ (* First of all we load the configuration *)
+let _ =
+ let configuration_file = "/projects/helm/etc/uwobo.conf.xml" in
+ Helm_registry.load_from configuration_file
+;;
+
(* 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_port = 58080 ;;
-let port_env_var = "UWOBO_PORT" ;;
-let log_env_var = "UWOBO_LOG_FILE" ;;
let default_media_type = "text/html" ;;
let default_encoding = "utf8" ;;
-let port =
- try
- int_of_string (Sys.getenv port_env_var)
- with
- | Not_found -> default_port
- | Failure "int_of_string" ->
- prerr_endline "Warning: invalid port number" ;
- exit (-1)
+
+let get_media_type props =
+ try
+ List.assoc "media-type" props
+ with
+ Not_found -> default_media_type
;;
-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
- with
- Not_found ->
- default_log_base_file ^ (string_of_int port) ^ default_log_extension)
+
+let get_encoding props =
+ try
+ List.assoc "encoding" props
+ with
+ Not_found -> default_encoding
;;
-let logfile = logfilename_of_port true port;;
+
+let port = Helm_registry.get_int "uwobo.port";;
+
+let logfilename_of_port port =
+ let basename = Helm_registry.get "uwobo.log_basename" in
+ let extension = Helm_registry.get "uwobo.log_extension" in
+ basename ^ "_" ^ string_of_int port ^ extension
+;;
+
+let logfile = logfilename_of_port port;;
let logfile_perm = 0o640 ;;
let respond_html body outchan =
(* It can raise Failure "Connection refused" *)
(* It can raise Failure "Port already in use" *)
let start_new_session cmd_pipe res_pipe outchan port logfile =
- let environment =
- (* Here I am loosing the current value of port_env_var; *)
- (* this should not matter *)
- Unix.putenv port_env_var (string_of_int port) ;
- Unix.environment ()
- in
- (* Let's check that the port is free *)
- (try
- ignore
- (Http_client.Convenience.http_head_message
- ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
- raise (Failure "Port already in use")
- with
- Failure "Connection refused" -> ()
- ) ;
- 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
- | child when child > 0 ->
- (* let's check if the new UWOBO started correctly *)
- Unix.sleep 5 ;
- (* It can raise Failure "Connection refused" *)
- ignore
- (Http_client.Convenience.http_head_message
- ("http://127.0.0.1:" ^ string_of_int port ^ "/help"))
- | _ -> failwith "Can't fork :-("
+ (* Let's check that the port is free *)
+ (try
+ ignore
+ (Http_client.http_get
+ ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
+ raise (Failure "Port already in use")
+ with
+ Unix.Unix_error (Unix.ECONNREFUSED, _, _) -> ()
+ ) ;
+ match Unix.fork () with
+ 0 ->
+ 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 set up a new environment *)
+ let environment =
+ (* Here I am loosing the current value of port_env_var; *)
+ (* this should not matter *)
+ Unix.putenv "UWOBO__PORT" (string_of_int port) ;
+ Unix.environment ()
+ in
+ (* 4. 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 ;
+ (* It can raise Failure "Connection refused" *)
+ (try
+ ignore
+ (Http_client.http_get
+ ("http://127.0.0.1:" ^ string_of_int port ^ "/help"))
+ with Unix.Unix_error (Unix.ECONNREFUSED, _, _) ->
+ raise (Failure "Connection refused"))
+ | _ -> failwith "Can't fork :-("
;;
(* request handler action
| "/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
in
let content_type = (* value of Content-Type HTTP response header *)
sprintf "%s; charset=%s"
- (match media_type with None -> default_media_type | Some t -> t)
- (match encoding with None -> default_encoding | Some e -> e)
+ (match media_type with None -> get_media_type props | Some t -> t)
+ (match encoding with None -> get_encoding props | Some e -> e)
in
syslogger#log `Debug
(sprintf "sending output to client (Content-Type: %s)...."
projects / helm.git / blobdiff