- the mathql interpreter is not helm-dependent any more

[helm.git] / helm / graphs / tools / drawGraph.ml
diff --git a/helm/graphs/tools/drawGraph.ml b/helm/graphs/tools/drawGraph.ml

index 5c539c1c28eb94d83f46f26602b10339afed2d17..b7abfe901a25a0e6ebb530d90d3439375ea1b962 100644 (file)
--- 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,11 +25,17 @@
  
  open Printf;;
  
+let debug = true;;
+let debug_print s = if debug then prerr_endline s;;
+
  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,7 +51,25 @@ let port =
        prerr_endline "Warning: invalid port, reverting to default";
        default_port
  in
-let callback req outchan =
+let dir = try Sys.getenv dir_env_var with Not_found -> default_dir in
+let errmsg =
+  sprintf
+"<html>
+ <head>
+  <title>Graph: error</title>
+ </head>
+ <body>
+  <h1>Error occured while drawing graph!<br />Please report the occured problem</h1>
+  <h2>%s</h2>
+ </body>
+</html>"
+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: Http_types.request) outchan =
    try
      (match req#path with
      | "/draw" ->
@@ -55,10 +78,17 @@ let callback req outchan =
          wget (sprintf "%s&param.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
-        | _ ->
-            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;
@@ -67,13 +97,15 @@ 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)
          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