+++ /dev/null
-#!/usr/bin/perl
-
-use HTTP::Daemon;
-use HTTP::Status;
-use HTTP::Request;
-use LWP::UserAgent;
-use URI::Escape;
-use CGI;
-use FindBin;
-
-chdir $FindBin::Bin; # chdir to the directory of this perl script
-
-$drawgraphport = $ENV{'DRAW_GRAPH_PORT'} || $drawgraphport;
-
-my $d = new HTTP::Daemon LocalPort => $drawgraphport
- or die "Error: port $drawgraphport not available.";
-print "Please contact me at: <URL:", $d->url, ">\n";
-
-$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
-
-while (my $c = $d->accept) {
- if (fork() == 0) {
- while (my $r = $c->get_request) {
- if ($r->method eq 'GET' && $r->url->path eq "/draw") {
- 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";
-
- 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) {
- $c->send_file_response("prova.$$.html");
- } 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";
- $c->send_file_response("prova.$pid.gif");
- 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;
- $response->content("Graph Drawer Version: ???");
- $c->send_response($response);
- } else {
- $c->send_error(RC_FORBIDDEN)
- }
- }
- $c->close;
- undef($c);
- exit;
- } # fork
-}
+++ /dev/null
-#!/usr/bin/perl
-
-use HTTP::Daemon;
-use HTTP::Status;
-use HTTP::Response;
-use CGI;
-
-$urisetqueueport = $ENV{'URI_SET_QUEUE_PORT'} || $urisetqueueport;
-
-my $d = new HTTP::Daemon LocalPort => $urisetqueueport
- or die "Error: port $urisetqueueport not available.";
-print "Please contact me at: <URL:", $d->url, ">\n";
-
-$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
-
-my %uri_sets;
-my %uri_queues;
-my %overflowed;
-my %size;
-
-#NOT REENTRANT: CAN NOT FORK DUE TO THE GLOBAL VARIABLES %uri_sets & ...
-#HENCE, THE "PID" ARGUMENT OF EVERY REQUEST MUST IDENTIFY THE SET OF URI
-#IT WANTS TO WORK WITH. MOREOVER, EVERY CLIENT MUST WORK WITH A DIFFERENT SET
-#OF URI, I.E. EVERY PID MUST BE UNIQUE.
-
-#CSC: WHAT IF THE CLIENTS ARE ON DIFFERENT MACHINES AND HAVE THE SAME PID?
-
-while (my $c = $d->accept) {
- while (my $r = $c->get_request) {
- if ($r->method eq 'GET' and $r->url->path eq '/add_if_not_in') {
- my $http_query = $r->url->equery;
- my $cgi = new CGI("$http_query");
- my $uri = $cgi->param('uri');
- my $pid = $cgi->param('PID');
- print "$pid: ";
- print(@{$uri_queues{$pid}} + 0);
- print "/";
- my $tot = keys(%{$uri_sets{$pid}}) + 0;
- $tot .= "*" if defined($overflowed{$pid});
- print "$tot $uri: ";
-
- my $res;
- if (!(defined($uri_sets{$pid}->{$uri}))) {
- if ($tot + 1 > $size{$pid}) {
- $res = "not_added_because_already_too_many";
- $overflowed{$pid} = 1;
- } else {
- $uri_sets{$pid}->{$uri} = 1;
- push @{$uri_queues{$pid}},$uri;
- $res = "added";
- }
- } else {
- $res = "already_in";
- }
- print $res."\n";
-
- my $response = new HTTP::Response;
- $response->content("<?xml version=\"1.0\"?>\n<$res/>\n");
- $response->content_type('text/xml');
- $c->send_response($response);
- } elsif ($r->method eq 'GET' and $r->url->path eq '/is_overflowed') {
- my $http_query = $r->url->equery;
- my $cgi = new CGI("$http_query");
- my $pid = $cgi->param('PID');
- print "$pid: ";
- print(@{$uri_queues{$pid}} + 0);
- print "/";
- print(keys(%{$uri_sets{$pid}}) + 0);
- print "*" if defined($overflowed{$pid});
- my $res = defined($overflowed{$pid}) ? "true" : "false";
- print " is_overflowed: $res\n";
- my $response = new HTTP::Response;
- $response->content("<?xml version=\"1.0\"?>\n<$res/>\n");
- $response->content_type('text/xml');
- $c->send_response($response);
- } elsif ($r->method eq 'GET' and $r->url->path eq '/set_uri_set_size') {
- my $http_query = $r->url->equery;
- my $cgi = new CGI("$http_query");
- my $pid = $cgi->param('PID');
- my $size = $cgi->param('size');
- print "$pid: size := $size\n";
- $size{$pid} = $size;
- my $response = new HTTP::Response;
- $response->content("<?xml version=\"1.0\"?>\n<done/>\n");
- $response->content_type('text/xml');
- $c->send_response($response);
- } elsif ($r->method eq 'GET' and $r->url->path eq '/get_next') {
- my $http_query = $r->url->equery;
- my $cgi = new CGI("$http_query");
- my $pid = $cgi->param('PID');
- print "$pid: ";
- print(@{$uri_queues{$pid}} + 0);
- print "/";
- print(keys(%{$uri_sets{$pid}}) + 0);
- print "*" if defined($overflowed{$pid});
- print " ";
-
- my $elem = shift @{$uri_queues{$pid}};
- my $mark = $overflowed{$pid};
-
- my $response = new HTTP::Response;
- my $xml_header = "<?xml version=\"1.0\"?>\n";
- if (!defined($elem)) {
- print "is now empty\n";
- $response->content("$xml_header<empty/>\n");
- } elsif ($mark == 1) {
- print "$elem (marked) removed\n";
- $response->content("$xml_header<marked_uri value=\"$elem\"/>\n");
- } else {
- print "$elem removed\n";
- $response->content("$xml_header<uri value=\"$elem\"/>\n");
- }
- $response->content_type('text/xml');
- $c->send_response($response);
- } elsif ($r->method eq 'GET' and $r->url->path eq '/reset_to_empty') {
- my $pid = $r->url->query;
- $pid =~ s/[^=]*=//;
- # Next loop for debugging purposes only
- my $count = 1;
- while (my $e = shift @{$uri_queues{$pid}}) {
- print "#$count $e forced out of the set\n";
- $count++;
- }
- print "************\nThe URI set $pid is now empty again\n";
- delete($uri_sets{$pid});
- delete($overflowed{$pid});
- delete($size{$pid});
- my $response = new HTTP::Response;
- $response->content("<?xml version=\"1.0\"?>\n<done/>\n");
- $response->content_type('text/xml');
- $c->send_response($response);
- } elsif ($r->method eq 'GET' && $r->url->path eq "/help"){
- print "Help requested!\n";
- my $response = new HTTP::Response;
- $response->content("URI-Set (Queue) Version: ???");
- $c->send_response($response);
- } else {
- $c->send_error(RC_FORBIDDEN)
- }
- }
- $c->close;
- undef($c);
-}