X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fhbugs%2Fbroker.ml;h=691f9d11a35dde9b6ced74b15d0e01f2ab5e16b9;hb=de51a22214573437b5d6c2ae3b600e9d7bb8f9f6;hp=b86c08b9bd6d7df10aba7dc7939e87de00de2688;hpb=0575a1cb077087970f311b48f2e45dc4a01a6867;p=helm.git diff --git a/helm/ocaml/hbugs/broker.ml b/helm/ocaml/hbugs/broker.ml index b86c08b9b..691f9d11a 100644 --- a/helm/ocaml/hbugs/broker.ml +++ b/helm/ocaml/hbugs/broker.ml @@ -26,11 +26,13 @@ * http://helm.cs.unibo.it/ *) +(* $Id$ *) + open Hbugs_types;; open Printf;; let debug = true ;; -let debug_print s = if debug then prerr_endline s ;; +let debug_print s = if debug then prerr_endline (Lazy.force s) ;; let daemon_name = "H-Bugs Broker" ;; let default_port = 49081 ;; @@ -66,13 +68,13 @@ let do_critical = let mutex = Mutex.create () in fun action -> try -(* debug_print "Acquiring lock ..."; *) +(* debug_print (lazy "Acquiring lock ..."); *) Mutex.lock mutex; -(* debug_print "Lock Acquired!"; *) +(* debug_print (lazy "Lock Acquired!"); *) let res = Lazy.force action in -(* debug_print "Releaseing lock ..."; *) +(* debug_print (lazy "Releaseing lock ..."); *) Mutex.unlock mutex; -(* debug_print "Lock released!"; *) +(* debug_print (lazy "Lock released!"); *) res with e -> Mutex.unlock mutex; raise e ;; @@ -232,7 +234,7 @@ let handle_msg outchan msg = )) | msg -> (* unexpected message *) - debug_print "Unknown message!"; + debug_print (lazy "Unknown message!"); Hbugs_messages.respond_exc "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan) in @@ -241,7 +243,7 @@ let handle_msg outchan = if debug then (fun msg -> (* filter handle_msg through a function which dumps input messages *) - debug_print (Hbugs_messages.string_of_msg msg); + debug_print (lazy (Hbugs_messages.string_of_msg msg)); handle_msg outchan msg) else handle_msg outchan @@ -251,8 +253,8 @@ in (* thread action *) let callback (req: Http_types.request) outchan = try - debug_print ("Connection from " ^ req#clientAddr); - debug_print ("Received request: " ^ req#path); + debug_print (lazy ("Connection from " ^ req#clientAddr)); + debug_print (lazy ("Received request: " ^ req#path)); (match req#path with (* TODO write help message *) | "/help" -> return_xml_msg " not yet written " outchan @@ -265,7 +267,7 @@ let callback (req: Http_types.request) outchan = else Http_daemon.respond_error ~code:400 outchan | _ -> Http_daemon.respond_error ~code:400 outchan); - debug_print "Done!\n" + debug_print (lazy "Done!\n") with | Http_types.Param_not_found attr_name -> Hbugs_messages.respond_exc "missing_parameter" attr_name outchan