X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fuwobo%2Fuwobo.ml;h=1a5b44f620264f3c862bc09f3759b25c68dd311c;hb=18c6848695fbfa97508e0981f6875a6459429a58;hp=345ccda59c53ccb2f769a34a50a283d6852ea2c2;hpb=9b12c7574b3d0e0b8bf3a3a67efa03e36abf3f0d;p=helm.git
diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 345ccda59..1a5b44f62 100644
--- a/helm/uwobo/uwobo.ml
+++ b/helm/uwobo/uwobo.ml
@@ -254,7 +254,7 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
(* Let's check that the port is free *)
(try
ignore
- (Http_client.http_get
+ (Http_user_agent.get
("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
raise (Failure "Port already in use")
with
@@ -298,7 +298,7 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
(* It can raise Failure "Connection refused" *)
(try
ignore
- (Http_client.http_get
+ (Http_user_agent.get
("http://127.0.0.1:" ^ string_of_int port ^ "/help"))
with Unix.Unix_error (Unix.ECONNREFUSED, _, _) ->
raise (Failure "Connection refused"))
@@ -442,7 +442,7 @@ let callback
let res = Uwobo_profiles.get_params pid ?password () in
respond_html
("
" ^
- String.concat "" (List.map (fun k,v -> "- " ^ k ^ " = " ^ v ^ "
") res) ^
+ String.concat "" (List.map (fun (k,v) -> "- " ^ k ^ " = " ^ v ^ "
") res) ^
"
") outchan
| "/setparams" ->
let serialized_param_value_list = serialize_param_list req#params in
@@ -517,6 +517,18 @@ let callback
syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri);
let domImpl = Gdome.domImplementation () in
let input = domImpl#createDocumentFromURI ~uri:xmluri () in
+ if debug then begin
+ let tmp_xml, tmp_uri =
+ let dir =
+ Filename.dirname (Helm_registry.get "uwobo.log_basename")
+ in
+ dir ^ "/input.xml", dir ^ "/input.uri"
+ in
+ ignore (domImpl#saveDocumentToFile ~doc:input ~name:tmp_xml ());
+ let oc = open_out tmp_uri in
+ output_string oc xmluri;
+ close_out oc
+ end;
syslogger#log `Debug "Applying stylesheet chain ...";
(try
let (write_result, media_type, encoding) = (* out_channel -> unit *)
@@ -772,9 +784,10 @@ let main () =
(sprintf "Ignoring invalid interprocess command: '%s'" cmd))
done
with
- Restart_HTTP_daemon ->
+ | Restart_HTTP_daemon ->
close_in cmd_pipe; (* these calls close also fds *)
close_out res_pipe
+ | Sys.Break as exn -> raise exn
| e -> (* Should we return a 404 error here? Maybe... (how?) *)
output_string res_pipe (Printexc.to_string e);
close_in cmd_pipe; (* these calls close also fds *)