[BACK]Return to lonc CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lonc between versions 1.36 and 1.38

version 1.36, 2002/03/27 04:07:02 version 1.38, 2002/04/04 22:04:54
Line 315  unless ( Line 315  unless (
 %outbuffer = ();  %outbuffer = ();
 %ready     = ();  %ready     = ();
 %servers   = (); # To be compatible with make filevector.  indexed by  %servers   = (); # To be compatible with make filevector.  indexed by
  # File descriptors, values are file descriptors.   # File ids, values are sockets.
  # note that the accept socket is omitted.   # note that the accept socket is omitted.
   
 tie %ready, 'Tie::RefHash';  tie %ready, 'Tie::RefHash';
   
 nonblock($server);  # nonblock($server);
 $select = IO::Select->new($server);  # $select = IO::Select->new($server);
   
 # Main loop: check reads/accepts, check writes, check ready to process  # Main loop: check reads/accepts, check writes, check ready to process
   
   status("Main loop");
 while (1) {  while (1) {
     my $client;      my $client;
     my $rv;      my $rv;
     my $data;      my $data;
   
     my $infdset; # bit vec of fd's to select on input.      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 $outfdset; # Bit vec of fd's to select on output.
     my $outreadyset; # bit vec of fds ready for output.  
   
   
     $infdset = MakeFileVector(\%servers);      $infdset = MakeFileVector(\%servers);
     $outfdset= MakeFileVector(\%outbuffer);      $outfdset= MakeFileVector(\%outbuffer);
       vec($infdset, $server->fileno, 1) = 1;
     # check for new information on the connections we have      if($DEBUG) {
     # anything to read or accept?   &logthis("Adding ".$server->fileno.
    " to input select vector (listner)".
     foreach $client ($select->can_read(00.10)) {   unpack("b*",$infdset)."\n");
         if ($client == $server) {  
             # accept a new connection  
             &status("Accept new connection: $conserver");  
             $client = $server->accept();  
             $select->add($client);  
             nonblock($client);  
         } else {  
             # read data  
             $data = '';  
             $rv   = $client->recv($data, POSIX::BUFSIZ, 0);  
   
             unless (defined($rv) && length $data) {  
                 # This would be the end of file, so close the client  
                 delete $inbuffer{$client};  
                 delete $outbuffer{$client};  
                 delete $ready{$client};  
   
                 &status("Idle");  
                 $select->remove($client);  
                 close $client;  
                 next;  
             }  
   
             $inbuffer{$client} .= $data;  
   
   
             # test whether the data in the buffer or the data we  
             # just read means there is a complete request waiting  
             # to be fulfilled.  If there is, set $ready{$client}  
             # to the requests waiting to be fulfilled.  
             while ($inbuffer{$client} =~ s/(.*\n)//) {  
                 push( @{$ready{$client}}, $1 );  
             }  
         }  
     }      }
           DoSelect(\$infdset, \$outfdset); # Wait for input.
     # Any complete requests to process?      if($DEBUG) {
     foreach $client (keys %ready) {   &logthis("Doselect completed!");
         handle($client);   &logthis("ins = ".unpack("b*",$infdset)."\n");
    &logthis("outs= ".unpack("b*",$outfdset)."\n");
     
     }      }
    
     # Buffers to flush?  
     foreach $client ($select->can_write(1)) {  
         # Skip this client if we have nothing to say  
         next unless exists $outbuffer{$client};  
   
         $rv = $client->send($outbuffer{$client}, 0);  
   
       unless ($outbuffer{$client} eq "con_lost\n") {  
         unless (defined $rv) {  
             # Whine, but move on.  
             &logthis("I was told I could write, but I can't.\n");  
             next;  
         }  
         $errno=$!;  
         if (($rv == length $outbuffer{$client}) ||  
             ($errno == POSIX::EWOULDBLOCK) || ($errno == 0)) {  
             substr($outbuffer{$client}, 0, $rv) = '';  
             delete $outbuffer{$client} unless length $outbuffer{$client};  
         } else {  
             # Couldn't write all the data, and it wasn't because  
             # it would have blocked.  Shutdown and move on.  
   
     &logthis("Dropping data with ".$errno.": ".      # Checkfor new connections:
                      length($outbuffer{$client}).", $rv");      if (vec($infdset, $server->fileno, 1)) {
    if($DEBUG) {
             delete $inbuffer{$client};      &logthis("New connection established");
             delete $outbuffer{$client};   }
             delete $ready{$client};   # accept a new connection
    &status("Accept new connection: $conserver");
             $select->remove($client);   $client = $server->accept();
             close($client);   if($DEBUG) {
             next;      &logthis("New client fd = ".$client->fileno."\n");
         }   }
       } else {   $servers{$client->fileno} = $client;
 # -------------------------------------------------------- Wow, connection lost   nonblock($client);
          &logthis(  
      "<font color=red>CRITICAL: Closing connection</font>");  
  &status("Connection lost");  
          $remotesock->shutdown(2);  
          &logthis("Attempting to open new connection");  
          &openremote($conserver);            
       }  
     }      }
          HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);
       HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,
    \%ready);
   # -------------------------------------------------------- Wow, connection lost
   
 }  }
      
       }
 }  }
   
 # ------------------------------------------------------- End of make_new_child  # ------------------------------------------------------- End of make_new_child
Line 446  sub MakeFileVector Line 391  sub MakeFileVector
     my $fdhash = shift;      my $fdhash = shift;
     my $selvar = "";      my $selvar = "";
   
     foreach $socket (keys %fdhash) {      foreach $socket (keys %$fdhash) {
  vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1;   if($DEBUG) {
       &logthis("Adding  ".$socket.
        "to select vector. (client)\n");
    }
    vec($selvar, $socket, 1) = 1;
     }      }
     return $selvar;      return $selvar;
 }  }
Line 458  sub MakeFileVector Line 407  sub MakeFileVector
 #    Processes output on a buffered set of file descriptors which are  #    Processes output on a buffered set of file descriptors which are
 #    ready to be read.  #    ready to be read.
 #  Parameters:  #  Parameters:
 #    $selvector - Vector of writable file descriptors which are writable.  #    $selvector - Vector of file descriptors which are writable.
 #    \%sockets  - Vector of socket references indexed by socket.  #    \%sockets  - Vector of socket references indexed by socket.
 #    \%buffers  - Reference to a hash containing output buffers.  #    \%buffers  - Reference to a hash containing output buffers.
 #                 Hashes are indexed by sockets.  The file descriptors of some  #                 Hashes are indexed by sockets.  The file descriptors of some
Line 477  sub HandleOutput Line 426  sub HandleOutput
     my $buffers   = shift;      my $buffers   = shift;
     my $inbufs    = shift;      my $inbufs    = shift;
     my $readys    = shift;      my $readys    = shift;
       my $sock;
   
     foreach $sock (keys %buffers) {      if($DEBUG) {
    &logthis("HandleOutput entered\n");
       }
   
       foreach $sock (keys %$sockets) {
  my $socket = $sockets->{$sock};   my $socket = $sockets->{$sock};
  if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable.   if(vec($selvector, $sock, 1)) { # $socket is writable.
     my $rv = $$socket->send($buffers->{$sock}, 0);      if($DEBUG) {
    &logthis("Sending $buffers->{$sock} \n");
       }
       my $rv = $socket->send($buffers->{$sock}, 0);
     $errno = $!;      $errno = $!;
     unless ($buffers->{$sock} eq "con_lost\n") {      unless ($buffers->{$sock} eq "con_lost\n") {
  unless (defined $rv) { # Write failed... could be EINTR   unless (defined $rv) { # Write failed... could be EINTR
Line 510  sub HandleOutput Line 467  sub HandleOutput
     delete $inbufs->{$sock};      delete $inbufs->{$sock};
     delete $readys->{$sock};      delete $readys->{$sock};
   
     close($$socket); # Close the client socket.      close($socket); # Close the client socket.
     next;      next;
  }   }
     } else { # Kludgy way to mark lond connection lost.      } else { # Kludgy way to mark lond connection lost.
Line 519  sub HandleOutput Line 476  sub HandleOutput
  status("Connection lost");   status("Connection lost");
  $remotesock->shutdown(2);   $remotesock->shutdown(2);
  &logthis("Attempting to open a new connection");   &logthis("Attempting to open a new connection");
  &openremot($conserver);   &openremote($conserver);
     }      }
         
  }   }
Line 553  sub HandleInput Line 510  sub HandleInput
     my $ibufs   = shift;      my $ibufs   = shift;
     my $obufs   = shift;      my $obufs   = shift;
     my $ready   = shift;      my $ready   = shift;
       my $sock;
   
     foreach $sock (keys %sockets) {      if($DEBUG) {
    &logthis("Entered HandleInput\n");
       }
       foreach $sock (keys %$sockets) {
  my $socket = $sockets->{$sock};   my $socket = $sockets->{$sock};
  if(vec($selvec, $$socket->fileno, 1)) { # Socket which is readable.   if(vec($selvec, $sock, 1)) { # Socket which is readable.
   
     #  Attempt to read the data and do error management.      #  Attempt to read the data and do error management.
     my $data = '';      my $data = '';
     my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0);      my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
       if($DEBUG) {
    &logthis("Received $data from socket");
       }
     unless (defined($rv) && length $data) {      unless (defined($rv) && length $data) {
   
  # Read an end of file.. this is a disconnect from the peer.   # Read an end of file.. this is a disconnect from the peer.
Line 571  sub HandleInput Line 535  sub HandleInput
  delete $ready->{$sock};   delete $ready->{$sock};
   
  status("Idle");   status("Idle");
  close $$socket;   close $socket;
  next;   next;
     }      }
     #  Append the read data to the input buffer. If the buffer      #  Append the read data to the input buffer. If the buffer
Line 611  sub DoSelect { Line 575  sub DoSelect {
     my $ins;      my $ins;
   
     while (1) {      while (1) {
  my $nfds = select($outs = $$writevec, $ins = $$readvec, undef, undef);   my $nfds = select( $ins = $$readvec, $outs = $$writevec, undef, undef);
  if($nfound) {   if($nfds) {
       if($DEBUG) {
    &logthis("select exited with ".$nfds." fds\n");
    &logthis("ins = ".unpack("b*",$ins).
    " readvec = ".unpack("b*",$$readvec)."\n");
    &logthis("outs = ".unpack("b*",$outs).
    " writevec = ".unpack("b*",$$writevec)."\n");
       }
     $$readvec  = $ins;      $$readvec  = $ins;
     $$writevec = $outs;      $$writevec = $outs;
     return;      return;
  } else {   } else {
       if($DEBUG) {
    &logthis("Select exited with no bits set in mask\n");
       }
     die "Select failed" unless $! == EINTR;      die "Select failed" unless $! == EINTR;
  }   }
     }      }
Line 707  sub handle { Line 681  sub handle {
     }      }
 }  }
 # ---------------------------------------------------------- End make_new_child  # ---------------------------------------------------------- End make_new_child
 }  
   
 # nonblock($socket) puts socket into nonblocking mode  # nonblock($socket) puts socket into nonblocking mode
 sub nonblock {  sub nonblock {
Removed from v.1.36  
changed lines
  Added in v.1.38

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