--- /dev/null
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+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 wget url fname =
+ prerr_endline (sprintf "DEBUG: wgetting url '%s'" url);
+ let oc = open_out fname in
+ Http_user_agent.get_iter (output_string oc) url;
+ close_out oc
+;;
+
+let errmsg =
+ sprintf
+"<html>
+ <head>
+ <title>Graph: error</title>
+ </head>
+ <body>
+ <h1>Error occurred 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" ->
+ 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 tmp PID=%d > log.%d" pid pid) with
+ | Unix.WEXITED 0 ->
+ 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_tmp; rm -f prova0.%s.dot" pid pid))
+ | invalid_request ->
+ Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+ outchan)
+ with
+ | 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
+
projects / helm.git / blobdiff