From 74b066524fed3d838137fd17c2abdb3d4544d824 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 20 Nov 2002 16:30:18 +0000 Subject: [PATCH] - get working directory from env var DRAW_GRAPH_DIR - in case of make failure (which in turn usually depends on uwobo's failure) return an error message in HTML format - bugfix: return html file instead of ... nothing :) - bugfix: print real current directory --- helm/graphs/tools/drawGraph.ml | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) 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 -- 2.39.2