X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fuwobo.ml;h=a9755885d2463f65490c4f263c1d0ccc0f09c02d;hb=b38de2d3fa8bbe346c59c18bbeb889f29e493f63;hp=0a0294c41a051828d528f0eabf0f7f688283b1aa;hpb=39c8c5c53680cd374a3eb76993a592cf29bb92ba;p=helm.git

diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 0a0294c41..a9755885d 100644
--- a/helm/uwobo/uwobo.ml
+++ b/helm/uwobo/uwobo.ml
@@ -44,6 +44,21 @@ let port_env_var = "UWOBO_PORT" ;;
 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 get_media_type props =
+ try
+  List.assoc "media-type" props
+ with
+  Not_found -> default_media_type
+;;
+
+let get_encoding props =
+ try
+  List.assoc "encoding" props
+ with
+  Not_found -> default_encoding
+;;
+
 let port =
   try
     int_of_string (Sys.getenv port_env_var)
@@ -210,11 +225,11 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
   (* Let's check that the port is free *)
   (try
     ignore
-     (Http_client.Convenience.http_head_message
+     (Http_client.http_get
        ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
     raise (Failure "Port already in use")
    with
-    Failure "Connection refused" -> ()
+    Unix.Unix_error (Unix.ECONNREFUSED, _, _) -> ()
   ) ;
   match Unix.fork () with
      0 ->
@@ -243,9 +258,12 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
       (* 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"))
+      (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 :-("
 ;;
 
@@ -353,8 +371,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)...."