(* 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 oc = open_out fname in
Http_client.http_get_iter (output_string oc) url;
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
"
Graph: error
Error occured while drawing graph!
Please report the occured problem
%s
"
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 ~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