--- loncom/Attic/lonc 2002/03/20 03:42:45 1.33 +++ loncom/Attic/lonc 2002/03/26 04:37:59 1.35 @@ -5,7 +5,7 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # -# $Id: lonc,v 1.33 2002/03/20 03:42:45 foxr Exp $ +# $Id: lonc,v 1.35 2002/03/26 04:37:59 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -314,6 +314,9 @@ unless ( %inbuffer = (); %outbuffer = (); %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'; @@ -326,11 +329,20 @@ while (1) { my $rv; 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? - foreach $client ($select->can_read(100.0)) { + foreach $client ($select->can_read(00.10)) { if ($client == $server) { # accept a new connection &status("Accept new connection: $conserver"); @@ -421,7 +433,167 @@ while (1) { # ------------------------------------------------------- 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( + "CRITICAL lond connection lost"); + 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 +# sub handle { # requests are in $ready{$client} # send output to $outbuffer{$client}