X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fgraphs%2Ftools%2FuriSetQueue.ml;h=43027580016fe58101457ccc8ae38398ff8f0e8c;hb=d622a1ce338d9db774ddc8b98fa58cdcec7b22e5;hp=29482c26817dfd79571b732eba9fc9f84cc123ec;hpb=14d838b61590fe8ee7a599013bab547a2e542ff3;p=helm.git
diff --git a/helm/graphs/tools/uriSetQueue.ml b/helm/graphs/tools/uriSetQueue.ml
index 29482c268..430275800 100644
--- a/helm/graphs/tools/uriSetQueue.ml
+++ b/helm/graphs/tools/uriSetQueue.ml
@@ -29,9 +29,8 @@ 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 "\n<%s/>\n" result);
+ res#setBody (sprintf "\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 "\n<%s/>\n" result);
+ res#setBody (sprintf "\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 "\n\n";
+ res#setBody "\n\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 -> ""
in
- res#setContents ("\n" ^ element ^ "\n");
+ res#setBody ("\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 "\n\n";
+ res#setBody "\n\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