+++ /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 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;
- 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
-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 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 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; rm -f prova0.%s.dot" pid pid))
- | invalid_request ->
- Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
- with
- | 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
-
projects / helm.git / blobdiff