X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fgraphs%2Ftools%2FdrawGraph.ml;h=0caba5bef371018e00a7bc26d217991a5feaa78c;hb=35f81e48378eba29e8b8d6dc0eaf22d20f55f3c7;hp=5c539c1c28eb94d83f46f26602b10339afed2d17;hpb=4c67cc0208078e3952a5146563d4d49116f7edf4;p=helm.git
diff --git a/helm/graphs/tools/drawGraph.ml b/helm/graphs/tools/drawGraph.ml
index 5c539c1c2..0caba5bef 100644
--- a/helm/graphs/tools/drawGraph.ml
+++ b/helm/graphs/tools/drawGraph.ml
@@ -24,13 +24,20 @@
* http://cs.unibo.it/helm/.
*)
+let debug = true;;
+let debug_print s = if debug then prerr_endline s;;
+Http_common.debug := debug;;
+
open Printf;;
let daemon_name = "Draw Graph";;
let default_port = 48083;;
+let default_dir = "/projects/helm/graphs/tools";;
let port_env_var = "DRAW_GRAPH_PORT";;
+let dir_env_var = "DRAW_GRAPH_DIR";;
let wget url fname =
+ prerr_endline (sprintf "DEBUG: wgetting url '%s'" url);
let data = Http_client.Convenience.http_get url in
let oc = open_out fname in
output_string oc data;
@@ -46,6 +53,17 @@ let port =
prerr_endline "Warning: invalid port, reverting to default";
default_port
in
+let dir = try Sys.getenv dir_env_var with Not_found -> default_dir in
+let errmsg =
+"
+
+ Graph: error
+
+
+ Error occured while drawing graph!
Please report the occured problem
+
+"
+in
let callback req outchan =
try
(match req#path with
@@ -55,10 +73,13 @@ let callback req outchan =
wget (sprintf "%s¶m.PID=%d" url pid) (sprintf "prova0.%d.dot" pid);
(match Unix.system (sprintf "make PID=%d > log.%d" pid pid) with
| Unix.WEXITED 0 ->
- Http_daemon.respond_file (sprintf "") outchan
+ debug_print "HTML successfully generated";
+ Http_daemon.respond_file (sprintf "prova.%d.html" pid) outchan
| _ ->
- Http_daemon.respond_error
- ~status:(`Server_error `Internal_server_error) outchan)
+ debug_print "Failure, sending error message";
+ let res = new Http_response.response in
+ res#setContents errmsg;
+ Http_daemon.respond_with res outchan)
| "/get_gif" ->
let pid = req#param "pid" in
Http_daemon.respond_file (sprintf "prova.%s.gif" pid) outchan;
@@ -73,7 +94,9 @@ let callback req outchan =
~body:(sprintf "Parameter '%s' is missing" attr_name)
outchan
in
+Sys.chdir dir;
printf "%s started and listening on port %d\n" daemon_name port;
+printf "current directory is %s\n" (Sys.getcwd ());
flush stdout;
Http_daemon.start' ~port callback;
printf "%s is terminating, bye!\n" daemon_name