ocaml 3.09 transition

[helm.git] / helm / graphs / tools / uriSetQueue.ml

diff --git a/helm/graphs/tools/uriSetQueue.ml b/helm/graphs/tools/uriSetQueue.ml
index 1bb6b5ee4c4fa58c83eeb41b0f7733a46e4a020e..43027580016fe58101457ccc8ae38398ff8f0e8c 100644 (file)
--- a/helm/graphs/tools/uriSetQueue.ml
+++ b/helm/graphs/tools/uriSetQueue.ml
@@ -23,15 +23,14 @@
  * http://cs.unibo.it/helm/.
  *)
 
-Http_common.debug := true;;
 let debug = true;;
 let debug_print s = if debug then prerr_endline s;;
+Http_common.debug := debug;;
 
 open Printf;;
 
+let configuration_file = "/projects/helm/etc/uriSetQueue.conf.xml";;
 let daemon_name = "Uri Set Queue";;
-let default_port = 48082;;
-let port_env_var = "URI_SET_QUEUE_PORT";;
 
 module OrderedUri: Set.OrderedType with type t = string =
   struct
@@ -77,18 +76,9 @@ let queue_mem item queue =  (* mem function over queues *)
   with Found -> true
 ;;
 
-let port =
+let callback (req: Http_types.request) outchan =
   try
-    int_of_string (Sys.getenv port_env_var)
-  with
-  | Not_found -> default_port
-  | Failure "int_of_string" ->
-      prerr_endline "Warning: invalid port, reverting to default";
-      default_port
-in
-let callback req outchan =
-  try
-    let res = new Http_response.response in
+    let res = new Http_response.response () in
     res#addBasicHeaders;
     res#setContentType "text/xml";
     (match req#path with
@@ -118,7 +108,7 @@ let callback req outchan =
                 end
             end
         in
-        res#setContents (sprintf "<?xml version=\"1.0\"?>\n<%s/>\n" result);
+        res#setBody (sprintf "<?xml version=\"1.0\"?>\n<%s/>\n" result);
         if debug then res#serialize stderr;
         Http_daemon.respond_with res outchan
 
@@ -127,7 +117,7 @@ let callback req outchan =
         let queue = get_queue pid in
         let result = string_of_bool (queue.overflowed) in
         debug_print (sprintf "%d queue is_overflowed = %s" pid result);
-        res#setContents (sprintf "<?xml version=\"1.0\"?>\n<%s/>\n" result);
+        res#setBody (sprintf "<?xml version=\"1.0\"?>\n<%s/>\n" result);
         if debug then res#serialize stderr;
         Http_daemon.respond_with res outchan
 
@@ -142,7 +132,7 @@ let callback req outchan =
         with Queue_not_found p ->
           assert (p = pid);
           add_queue pid size);
-        res#setContents "<?xml version=\"1.0\"?>\n<done/>\n";
+        res#setBody "<?xml version=\"1.0\"?>\n<done/>\n";
         if debug then res#serialize stderr;
         Http_daemon.respond_with res outchan
 
@@ -160,7 +150,7 @@ let callback req outchan =
               uri
           with Queue.Empty -> "<empty/>"
         in
-        res#setContents ("<?xml version=\"1.0\"?>\n" ^ element ^ "\n");
+        res#setBody ("<?xml version=\"1.0\"?>\n" ^ element ^ "\n");
         if debug then res#serialize stderr;
         Http_daemon.respond_with res outchan
 
@@ -168,31 +158,33 @@ let callback req outchan =
         let pid = int_of_string (req#param "PID") in
         remove_queue pid;
         debug_print (sprintf "Resetting queue '%d'" pid);
-        res#setContents "<?xml version=\"1.0\"?>\n<done/>\n";
+        res#setBody "<?xml version=\"1.0\"?>\n<done/>\n";
         if debug then res#serialize stderr;
         Http_daemon.respond_with res outchan
 
     | invalid_request ->
         debug_print ("Invalid request received");
-        Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
+        Http_daemon.respond_error
+          ~code:(`Status (`Client_error `Bad_request)) outchan);
         prerr_endline "Request done!\n"
   with
-  | Http_request.Param_not_found attr_name ->
-      Http_daemon.respond_error
-        ~status:(`Client_error `Bad_request)
+  | Http_types.Param_not_found attr_name ->
+      Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
         ~body:(sprintf "Parameter '%s' is missing" attr_name)
         outchan
   | Failure "int_of_string" ->  (* error in converting some paramters *)
-      Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan
-  | Queue_not_found queue_name ->
       Http_daemon.respond_error
-        ~status:(`Client_error `Bad_request)
+        ~code:(`Status (`Client_error `Bad_request)) outchan
+  | Queue_not_found queue_name ->
+      Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
         ~body:(sprintf "Queue '%d' is not defined" queue_name)
         outchan
 in
 
+Helm_registry.load_from configuration_file;
+let port = Helm_registry.get_int "uri_set_queue.port" in
 printf "%s started and listening on port %d\n" daemon_name port;
 flush stdout;
-Http_daemon.start' ~port ~fork:false callback;
+Http_daemon.start' ~port ~mode:`Thread callback;
 printf "%s is terminating, bye!\n" daemon_name