#!/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, ">\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("\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("\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("\n\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 = "\n"; if (!defined($elem)) { print "is now empty\n"; $response->content("$xml_header\n"); } elsif ($mark == 1) { print "$elem (marked) removed\n"; $response->content("$xml_header\n"); } else { print "$elem removed\n"; $response->content("$xml_header\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("\n\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); }