2 (* Copyright (C) 2002, HELM Team.
4 * This file is part of HELM, an Hypertextual, Electronic
5 * Library of Mathematics, developed at the Computer Science
6 * Department, University of Bologna, Italy.
8 * HELM is free software; you can redistribute it and/or
9 * modify it under the terms of the GNU General Public License
10 * as published by the Free Software Foundation; either version 2
11 * of the License, or (at your option) any later version.
13 * HELM is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
18 * You should have received a copy of the GNU General Public License
19 * along with HELM; if not, write to the Free Software
20 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
23 * For details, see the HELM World-Wide-Web page,
24 * http://cs.unibo.it/helm/.
28 let debug_print s = if debug then prerr_endline s;;
29 Http_common.debug := debug;;
33 let daemon_name = "Draw Graph";;
34 let default_port = 48083;;
35 let default_dir = "/projects/helm/graphs/tools";;
36 let port_env_var = "DRAW_GRAPH_PORT";;
37 let dir_env_var = "DRAW_GRAPH_DIR";;
40 prerr_endline (sprintf "DEBUG: wgetting url '%s'" url);
41 let data = Http_client.Convenience.http_get url in
42 let oc = open_out fname in
43 output_string oc data;
49 int_of_string (Sys.getenv port_env_var)
51 | Not_found -> default_port
52 | Failure "int_of_string" ->
53 prerr_endline "Warning: invalid port, reverting to default";
56 let dir = try Sys.getenv dir_env_var with Not_found -> default_dir in
60 <title>Graph: error</title>
63 <h1>Error occured while drawing graph!<br />Please report the occured problem</h1>
67 let callback req outchan =
71 let url = req#param "url" in
72 let pid = Unix.getpid () in
73 wget (sprintf "%s¶m.PID=%d" url pid) (sprintf "prova0.%d.dot" pid);
74 (match Unix.system (sprintf "make PID=%d > log.%d" pid pid) with
76 debug_print "HTML successfully generated";
77 Http_daemon.respond_file (sprintf "prova.%d.html" pid) outchan
79 debug_print "Failure, sending error message";
80 let res = new Http_response.response in
81 res#setContents errmsg;
82 Http_daemon.respond_with res outchan)
84 let pid = req#param "pid" in
85 Http_daemon.respond_file (sprintf "prova.%s.gif" pid) outchan;
87 sprintf "make PID=%s clean; rm -f prova0.%s.dot" pid pid))
89 Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
91 | Http_request.Param_not_found attr_name ->
92 Http_daemon.respond_error
93 ~status:(`Client_error `Bad_request)
94 ~body:(sprintf "Parameter '%s' is missing" attr_name)
98 printf "%s started and listening on port %d\n" daemon_name port;
99 printf "current directory is %s\n" (Sys.getcwd ());
101 Http_daemon.start' ~port callback;
102 printf "%s is terminating, bye!\n" daemon_name