open Printf;;
let debug = true ;;
-let debug_print s = if debug then prerr_endline s ;;
-Http_common.debug := false;;
+let debug_print s = if debug then prerr_endline (Lazy.force s) ;;
let daemon_name = "H-Bugs Broker" ;;
let default_port = 49081 ;;
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
;;
))
| 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
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
(* 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 "<help> not yet written </help>" 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