Diff for /loncom/Attic/lonc between versions 1.34 and 1.35

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}

Removed from v.1.34  
changed lines
  Added in v.1.35


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>