X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fgraphs%2Ftools%2FdrawGraph.ml;h=b7abfe901a25a0e6ebb530d90d3439375ea1b962;hb=2779c4191d0c14aa7bec9a861974a6a1f815ca03;hp=0caba5bef371018e00a7bc26d217991a5feaa78c;hpb=74b066524fed3d838137fd17c2abdb3d4544d824;p=helm.git
diff --git a/helm/graphs/tools/drawGraph.ml b/helm/graphs/tools/drawGraph.ml
index 0caba5bef..b7abfe901 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
@@ -24,11 +23,10 @@
* http://cs.unibo.it/helm/.
*)
+open Printf;;
+
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;;
@@ -55,16 +53,23 @@ let port =
in
let dir = try Sys.getenv dir_env_var with Not_found -> default_dir in
let errmsg =
+ sprintf
"
Graph: error
Error occured while drawing graph!
Please report the occured problem
+ %s
"
in
-let callback req outchan =
+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: Http_types.request) outchan =
try
(match req#path with
| "/draw" ->
@@ -75,11 +80,15 @@ let callback req outchan =
| Unix.WEXITED 0 ->
debug_print "HTML successfully generated";
Http_daemon.respond_file (sprintf "prova.%d.html" pid) outchan
- | _ ->
- debug_print "Failure, sending error message";
- let res = new Http_response.response in
- res#setContents errmsg;
- Http_daemon.respond_with res 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;
@@ -88,7 +97,7 @@ let callback req outchan =
| invalid_request ->
Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
with
- | Http_request.Param_not_found attr_name ->
+ | Http_types.Param_not_found attr_name ->
Http_daemon.respond_error
~status:(`Client_error `Bad_request)
~body:(sprintf "Parameter '%s' is missing" attr_name)