X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fuwobo.ml;h=d680f9e2825d6ff6f80ff10efb90188a2e2c53a6;hb=5ef9ec31b2e7acb2f58da1aa13c822992f65e45b;hp=450449ec41d2d27db3054ed9cd0f7ba653d7a796;hpb=4356ee2e1a539506c28d90bc171cfffe8e1998b4;p=helm.git

diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 450449ec4..d680f9e28 100644
--- a/helm/uwobo/uwobo.ml
+++ b/helm/uwobo/uwobo.ml
@@ -35,32 +35,41 @@ let debug_level = `Notice ;;
 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 =
@@ -199,49 +208,57 @@ let veillogger = new Uwobo_common.libXsltLogger ;;
   (* 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
@@ -276,38 +293,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
@@ -348,8 +365,8 @@ let callback
           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)...."