X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fgraphs%2Ftools%2FdrawGraph.ml;h=c17902fbc551dd85e92f0a4a5315fee500d978f7;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=5c539c1c28eb94d83f46f26602b10339afed2d17;hpb=4c67cc0208078e3952a5146563d4d49116f7edf4;p=helm.git
diff --git a/helm/graphs/tools/drawGraph.ml b/helm/graphs/tools/drawGraph.ml
index 5c539c1c2..c17902fbc 100644
--- a/helm/graphs/tools/drawGraph.ml
+++ b/helm/graphs/tools/drawGraph.ml
@@ -1,4 +1,3 @@
-
(* Copyright (C) 2002, HELM Team.
*
* This file is part of HELM, an Hypertextual, Electronic
@@ -26,54 +25,76 @@
open Printf;;
+let debug = true;;
+let debug_print s = if debug then prerr_endline s;;
+
+let configuration_file = "/projects/helm/etc/drawGraph.conf.xml";;
+
let daemon_name = "Draw Graph";;
-let default_port = 48083;;
-let port_env_var = "DRAW_GRAPH_PORT";;
let wget url fname =
- let data = Http_client.Convenience.http_get url in
+ prerr_endline (sprintf "DEBUG: wgetting url '%s'" url);
let oc = open_out fname in
- output_string oc data;
+ Http_user_agent.get_iter (output_string oc) url;
close_out oc
;;
-let port =
- 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
+let errmsg =
+ sprintf
+"
+
+ Graph: error
+
+
+ Error occurred while drawing graph!
Please report the occured problem
+ %s
+
+"
+in
+let string_of_exit_status = function
+ | Unix.WEXITED n -> sprintf "Process exited with code %d" n
+ | Unix.WSIGNALED n -> sprintf "Process killed by signal %d" n
+ | Unix.WSTOPPED n -> sprintf "Process stopped by signal %d" n
in
-let callback req outchan =
+let callback (req: Http_types.request) outchan =
try
(match req#path with
| "/draw" ->
let url = req#param "url" in
let pid = Unix.getpid () in
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
+ (match Unix.system (sprintf "make tmp PID=%d > log.%d" pid pid) with
| Unix.WEXITED 0 ->
- Http_daemon.respond_file (sprintf "") outchan
- | _ ->
- Http_daemon.respond_error
- ~status:(`Server_error `Internal_server_error) outchan)
+ debug_print "HTML successfully generated";
+ Http_daemon.respond_file (sprintf "prova.%d.html" pid) outchan
+ | status ->
+ debug_print "Failure, sending error message";
+ let res =
+ new Http_response.response
+ ~body:
+ (errmsg ("Exit status: " ^ (string_of_exit_status status)))
+ ()
+ in
+ Http_daemon.respond_with res outchan)
| "/get_gif" ->
let pid = req#param "pid" in
Http_daemon.respond_file (sprintf "prova.%s.gif" pid) outchan;
ignore (Unix.system (
- sprintf "make PID=%s clean; rm -f prova0.%s.dot" pid pid))
+ sprintf "make PID=%s clean_tmp; rm -f prova0.%s.dot" pid pid))
| invalid_request ->
- Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
+ Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+ outchan)
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
in
+Helm_registry.load_from configuration_file;
+let port = Helm_registry.get_int "draw_graph.port" in
+Sys.chdir (Helm_registry.get "draw_graph.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