--- /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 daemon_name = "Draw Graph";;
+let default_port = 48083;;
+let port_env_var = "DRAW_GRAPH_PORT";;
+
+let wget url fname =
+ 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 callback req 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 ->
+ Http_daemon.respond_file (sprintf "") outchan
+ | _ ->
+ Http_daemon.respond_error
+ ~status:(`Server_error `Internal_server_error) 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_request.Param_not_found attr_name ->
+ Http_daemon.respond_error
+ ~status:(`Client_error `Bad_request)
+ ~body:(sprintf "Parameter '%s' is missing" attr_name)
+ outchan
+in
+printf "%s started and listening on port %d\n" daemon_name port;
+flush stdout;
+Http_daemon.start' ~port callback;
+printf "%s is terminating, bye!\n" daemon_name
+
my $http_query = $r->url->equery;
my $cgi = new CGI("$http_query");
my $url = $cgi->param('url');
- $url = $url.'¶m.PID='.$$;
- print "URL: $url\n";
+ $url = $url.'¶m.PID='.$$;
+ print "URL: $url\n";
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new(GET => "$url");
my $response = $ua->request($request, "prova0.$$.dot");
- if (system("make PID=$$ > log.$$") == 0) {
+ if (system("make PID=$$ > log.$$") == 0) {
$c->send_file_response("prova.$$.html");
- } else {
- $c->send_error(RC_INTERNAL_SERVER_ERROR);
- }
+ } else {
+ $c->send_error(RC_INTERNAL_SERVER_ERROR);
+ }
} elsif ($r->method eq 'GET' && $r->url->path eq "/get_gif") {
my $http_query = $r->url->equery;
my $cgi = new CGI("$http_query");
my $pid = $cgi->param('pid');
- print "Returning GIF: $pid\n";
+ print "Returning GIF: $pid\n";
$c->send_file_response("prova.$pid.gif");
- system("make PID=$pid clean ; rm -f prova0.$pid.dot");
+ system("make PID=$pid clean ; rm -f prova0.$pid.dot");
} elsif ($r->method eq 'GET' && $r->url->path eq "/help"){
print "Help requested!\n";
- my $response = new HTTP::Response;
+ my $response = new HTTP::Response;
$response->content("Graph Drawer Version: ???");
$c->send_response($response);
} else {
--- /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 daemon_name = "Uri Set Queue";;
+let default_port = 48082;;
+let port_env_var = "URI_SET_QUEUE_PORT";;
+
+type uri_queue = {
+ mutable size: int;
+ mutable overflowed: bool;
+ uris: string Queue.t;
+}
+ (** raised when a queue is accessed before being defined *)
+exception Queue_not_found of int;;
+ (** global uri_queue, used by all children *)
+let uri_queue = { size = 0; overflowed = false; uris = Queue.create () };;
+let (get_queue, add_queue, remove_queue) =
+ let uri_queues = Hashtbl.create 17 in
+ ((fun pid -> (* get_queue *)
+ try
+ Hashtbl.find uri_queues pid
+ with Not_found -> raise (Queue_not_found pid)),
+ (fun pid size -> (* add_queue *)
+ Hashtbl.replace
+ uri_queues
+ pid
+ { size = size; overflowed = false; uris = Queue.create () }),
+ (fun pid -> (* remove_queue *)
+ try
+ Hashtbl.remove uri_queues pid
+ with Not_found -> raise (Queue_not_found pid)))
+;;
+
+exception Found;;
+let queue_mem item queue = (* mem function over queues *)
+ try
+ Queue.iter (fun e -> if item = e then raise Found) queue;
+ false
+ with Found -> true
+;;
+
+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 callback req outchan =
+ try
+ let res = new Http_response.response in
+ res#addBasicHeaders;
+ res#setContentType "text/xml";
+ (match req#path with
+
+ | "/add_if_not_in" ->
+ let (uri, pid) = (req#param "uri", int_of_string (req#param "PID")) in
+ let queue = get_queue pid in
+ let result =
+ if not (queue_mem uri queue.uris) then begin (* uri not in *)
+ if Queue.length queue.uris >= queue.size then begin (* overflow! *)
+ queue.overflowed <- true;
+ "not_added_because_already_too_many"
+ end else begin (* add the uri *)
+ Queue.add uri queue.uris;
+ "added"
+ end
+ end else (* url already in *)
+ "already_in"
+ in
+ res#setContents (sprintf "<?xml version=\"1.0\"?><%s/>\n" result);
+ Http_daemon.respond_with res outchan
+
+ | "/is_overflowed" ->
+ let pid = int_of_string (req#param "PID") in
+ let queue = get_queue pid in
+ let result = string_of_bool (queue.overflowed) in
+ res#setContents (sprintf "<?xml version=\"1.0\"?><%s/>\n" result);
+ Http_daemon.respond_with res outchan
+
+ | "/set_uri_set_size" ->
+ let (pid, size) =
+ (int_of_string (req#param "PID"), int_of_string (req#param "size"))
+ in
+ (try
+ let queue = get_queue pid in
+ queue.size <- size;
+ with Queue_not_found p ->
+ assert (p = pid);
+ add_queue pid size);
+ res#setContents "<?xml version=\"1.0\">\n<done/>\n";
+ Http_daemon.respond_with res outchan
+
+ | "/get_next" ->
+ let pid = int_of_string (req#param "PID") in
+ let queue = get_queue pid in
+ let element = (* xml response's root element *)
+ try
+ let uri = Queue.take queue.uris in
+ sprintf
+ "<%suri value=\"%s\"/>"
+ (if queue.overflowed then "marked_" else "")
+ uri
+ with Queue.Empty -> "<empty/>"
+ in
+ res#setContents ("<?xml version=\"1.0\">" ^ element ^ "\n");
+ Http_daemon.respond_with res outchan
+
+ | "/reset_to_empty" ->
+ let pid = int_of_string (req#param "PID") in
+ remove_queue pid;
+ res#setContents "<?xml version=\"1.0\">\n<done/>\n";
+ Http_daemon.respond_with res outchan
+
+ | invalid_request ->
+ Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
+ with
+ | Http_request.Param_not_found attr_name ->
+ Http_daemon.respond_error
+ ~status:(`Client_error `Bad_request)
+ ~body:(sprintf "Parameter '%s' is missing" attr_name)
+ outchan
+ | Failure "int_of_string" -> (* error in converting some paramters *)
+ Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan
+ | Queue_not_found queue_name ->
+ Http_daemon.respond_error
+ ~status:(`Client_error `Bad_request)
+ ~body:(sprintf "Queue '%d' is not defined" queue_name)
+ outchan
+in
+
+printf "%s started and listening on port %d\n" daemon_name port;
+flush stdout;
+Http_daemon.start' ~port ~fork:false callback;
+printf "%s is terminating, bye!\n" daemon_name
+
projects / helm.git / commitdiff