helm/graphs/tools/drawGraph.ml

   1
   2 (* Copyright (C) 2002, HELM Team.
   3  *
   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.
   7  *
   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.
  12  *
  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.
  17  *
  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,
  21  * MA  02111-1307, USA.
  22  *
  23  * For details, see the HELM World-Wide-Web page,
  24  * http://cs.unibo.it/helm/.
  25  *)
  26
  27 open Printf;;
  28
  29 let daemon_name = "Draw Graph";;
  30 let default_port = 48083;;
  31 let port_env_var = "DRAW_GRAPH_PORT";;
  32
  33 let wget url fname =
  34   let data = Http_client.Convenience.http_get url in
  35   let oc = open_out fname in
  36   output_string oc data;
  37   close_out oc
  38 ;;
  39
  40 let port =
  41   try
  42     int_of_string (Sys.getenv port_env_var)
  43   with
  44   | Not_found -> default_port
  45   | Failure "int_of_string" ->
  46       prerr_endline "Warning: invalid port, reverting to default";
  47       default_port
  48 in
  49 let callback req outchan =
  50   try
  51     (match req#path with
  52     | "/draw" ->
  53         let url = req#param "url" in
  54         let pid = Unix.getpid () in
  55         wget (sprintf "%s&param.PID=%d" url pid) (sprintf "prova0.%d.dot" pid);
  56         (match Unix.system (sprintf "make PID=%d > log.%d" pid pid) with
  57         | Unix.WEXITED 0 ->
  58             Http_daemon.respond_file (sprintf "") outchan
  59         | _ ->
  60             Http_daemon.respond_error
  61               ~status:(`Server_error `Internal_server_error) outchan)
  62     | "/get_gif" ->
  63         let pid = req#param "pid" in
  64         Http_daemon.respond_file (sprintf "prova.%s.gif" pid) outchan;
  65         ignore (Unix.system (
  66           sprintf "make PID=%s clean; rm -f prova0.%s.dot" pid pid))
  67     | invalid_request ->
  68         Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
  69   with
  70   | Http_request.Param_not_found attr_name ->
  71       Http_daemon.respond_error
  72         ~status:(`Client_error `Bad_request)
  73         ~body:(sprintf "Parameter '%s' is missing" attr_name)
  74         outchan
  75 in
  76 printf "%s started and listening on port %d\n" daemon_name port;
  77 flush stdout;
  78 Http_daemon.start' ~port callback;
  79 printf "%s is terminating, bye!\n" daemon_name
  80