ocaml 3.09 transition

[helm.git] / helm / uwobo / uwobo.ml

diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml
index 4154dfb3d3fdd9851f67a8ea7062915dc88ba1c8..1a5b44f620264f3c862bc09f3759b25c68dd311c 100644 (file)
--- 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"))
@@ -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 *)