(* 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 " Graph: error

Error occurred 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 ~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; let d_spec = Http_daemon.daemon_spec ~port ~callback ~auto_close:true () in Http_daemon.main d_spec; printf "%s is terminating, bye!\n" daemon_name