]> matita.cs.unibo.it Git - helm.git/commitdiff
- better error messages on make failure
authorStefano Zacchiroli <zack@upsilon.cc>
Sun, 23 Feb 2003 16:56:34 +0000 (16:56 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Sun, 23 Feb 2003 16:56:34 +0000 (16:56 +0000)
- synced with O'Http 0.0.8

helm/graphs/tools/drawGraph.ml

index 0caba5bef371018e00a7bc26d217991a5feaa78c..b7abfe901a25a0e6ebb530d90d3439375ea1b962 100644 (file)
@@ -1,4 +1,3 @@
-
 (* Copyright (C) 2002, HELM Team.
  * 
  * This file is part of HELM, an Hypertextual, Electronic
  * 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
 "<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 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)