version 1.34, 2002/03/20 03:44:11
|
version 1.35, 2002/03/26 04:37:59
|
Line 314 unless (
|
Line 314 unless (
|
%inbuffer = (); |
%inbuffer = (); |
%outbuffer = (); |
%outbuffer = (); |
%ready = (); |
%ready = (); |
|
%servers = (); # To be compatible with make filevector. indexed by |
|
# File descriptors, values are file descriptors. |
|
# note that the accept socket is omitted. |
|
|
tie %ready, 'Tie::RefHash'; |
tie %ready, 'Tie::RefHash'; |
|
|
Line 326 while (1) {
|
Line 329 while (1) {
|
my $rv; |
my $rv; |
my $data; |
my $data; |
|
|
# check for new information on the connections we have |
my $infdset; # bit vec of fd's to select on input. |
|
my $inreadyset; # Bit vec of fd's ready for input. |
|
|
|
my $outfdset; # Bit vec of fd's to select on output. |
|
my $outreadyset; # bit vec of fds ready for output. |
|
|
|
|
|
$infdset = MakeFileVector(\%servers); |
|
$outfdset= MakeFileVector(\%outbuffer); |
|
|
|
# check for new information on the connections we have |
# anything to read or accept? |
# anything to read or accept? |
|
|
foreach $client ($select->can_read(00.10)) { |
foreach $client ($select->can_read(00.10)) { |
Line 421 while (1) {
|
Line 433 while (1) {
|
|
|
# ------------------------------------------------------- End of make_new_child |
# ------------------------------------------------------- End of make_new_child |
|
|
|
|
|
# |
|
# Make a vector of file descriptors to wait for in a select. |
|
# parameters: |
|
# \%fdhash -reference to a hash which has IO::Socket's as indices. |
|
# We only care about the indices, not the values. |
|
# A select vector is created from all indices of the hash. |
|
|
|
sub MakeFileVector |
|
{ |
|
my $fdhash = shift; |
|
my $selvar = ""; |
|
|
|
foreach $socket (keys %fdhash) { |
|
vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1; |
|
} |
|
return $selvar; |
|
} |
|
|
|
|
|
# |
|
# HandleOutput: |
|
# Processes output on a buffered set of file descriptors which are |
|
# ready to be read. |
|
# Parameters: |
|
# $selvector - Vector of writable file descriptors which are writable. |
|
# \%sockets - Vector of socket references indexed by socket. |
|
# \%buffers - Reference to a hash containing output buffers. |
|
# Hashes are indexed by sockets. The file descriptors of some |
|
# of those sockets will be present in $selvector. |
|
# For each one of those, we will attempt to write the output |
|
# buffer to the socket. Note that we will assume that |
|
# the sockets are being run in non blocking mode. |
|
# \%inbufs - Reference to hash containing input buffers. |
|
# \%readys - Reference to hash containing flags for items with complete |
|
# requests. |
|
# |
|
sub HandleOutput |
|
{ |
|
my $selvector = shift; |
|
my $sockets = shift; |
|
my $buffers = shift; |
|
my $inbufs = shift; |
|
my $readys = shift; |
|
|
|
foreach $sock (keys %buffers) { |
|
my $socket = $sockets->{$sock}; |
|
if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable. |
|
my $rv = $$socket->send($buffers->{$sock}, 0); |
|
$errno = $!; |
|
unless ($buffers->{$sock} eq "con_lost\n") { |
|
unless (defined $rv) { # Write failed... could be EINTR |
|
unless ($errno == POSIX::EINTR) { |
|
&logthis("Write failed on writable socket"); |
|
} # EINTR is not an error .. just retry. |
|
next; |
|
} |
|
if( ($rv == length $buffers->{$sock}) || |
|
($errno == POSIX::EWOULDBLOCK) || |
|
($errno == POSIX::EAGAIN) || # same as above. |
|
($errno == POSIX::EINTR) || # signal during IO |
|
($errno == 0)) { |
|
substr($buffers->{$sock}, 0, $rv)=""; # delete written part |
|
delete $buffers->{$sock} unless length $buffers->{$sock}; |
|
} else { |
|
# For some reason the write failed with an error code |
|
# we didn't look for. Shutdown the socket. |
|
&logthis("Unable to write data with ".$errno.": ". |
|
"Dropping data: ".length($buffers->{$sock}). |
|
", $rv"); |
|
# |
|
# kill off the buffers in the hash: |
|
|
|
delete $buffers->{$sock}; |
|
delete $inbufs->{$sock}; |
|
delete $readys->{$sock}; |
|
|
|
close($$socket); # Close the client socket. |
|
next; |
|
} |
|
} else { # Kludgy way to mark lond connection lost. |
|
&logthis( |
|
"<font color=red>CRITICAL lond connection lost</font>"); |
|
status("Connection lost"); |
|
$remotesock->shutdown(2); |
|
&logthis("Attempting to open a new connection"); |
|
&openremot($conserver); |
|
} |
|
|
|
} |
|
} |
|
|
|
} |
|
# |
|
# HandleInput - Deals with input on client sockets. |
|
# Each socket has an associated input buffer. |
|
# For each readable socket, the currently available |
|
# data is appended to this buffer. |
|
# If necessary, the buffer is created. |
|
# On various failures, we may shutdown the client. |
|
# Parameters: |
|
# $selvec - Vector of readable sockets. |
|
# \%sockets - Refers to the Hash of sockets indexed by sockets. |
|
# Each of these may or may not have it's fd bit set |
|
# in the $selvec. |
|
# \%ibufs - Refers to the hash of input buffers indexed by socket. |
|
# \%obufs - Hash of output buffers indexed by socket. |
|
# \%ready - Hash of ready flags indicating the existence of a completed |
|
# Request. |
|
sub HandleInput |
|
{ |
|
|
|
# Marshall the parameters. Note that the hashes are actually |
|
# references not values. |
|
|
|
my $selvec = shift; |
|
my $sockets = shift; |
|
my $ibufs = shift; |
|
my $obufs = shift; |
|
my $ready = shift; |
|
|
|
foreach $sock (keys %sockets) { |
|
my $socket = $sockets->{$sock}; |
|
if(vec($selvec, $$socket->fileno, 1)) { # Socket which is readable. |
|
|
|
# Attempt to read the data and do error management. |
|
my $data = ''; |
|
my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0); |
|
unless (defined($rv) && length $data) { |
|
|
|
# Read an end of file.. this is a disconnect from the peer. |
|
|
|
delete $sockets->{$sock}; |
|
delete $ibufs->{$sock}; |
|
delete $obufs->{$sock}; |
|
delete $ready->{$sock}; |
|
|
|
status("Idle"); |
|
close $$socket; |
|
next; |
|
} |
|
# Append the read data to the input buffer. If the buffer |
|
# now contains a \n the request is complete and we can |
|
# mark this in the $ready hash (one request for each \n.) |
|
|
|
$ibufs->{$sock} .= $data; |
|
while($ibufs->{$sock} =~ s/(.*\n)//) { |
|
push(@{$ready->{$sock}}, $1); |
|
} |
|
|
|
} |
|
} |
|
# Now handle any requests which are ready: |
|
|
|
foreach $client (keys %ready) { |
|
handle($client); |
|
} |
|
} |
|
|
# handle($socket) deals with all pending requests for $client |
# handle($socket) deals with all pending requests for $client |
|
# |
sub handle { |
sub handle { |
# requests are in $ready{$client} |
# requests are in $ready{$client} |
# send output to $outbuffer{$client} |
# send output to $outbuffer{$client} |