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

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

version 1.36, 2002/03/27 04:07:02 version 1.43, 2002/10/30 14:50:04
Line 48 Line 48
 # 3/07/02 Ron Fox   # 3/07/02 Ron Fox 
 # based on nonforker from Perl Cookbook  # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking  # - server who multiplexes without forking
   # 5/11/2002 Scott Harrison
   
   use lib '/home/httpd/lib/perl/';
   use LONCAPA::Configuration;
   
 use POSIX;  use POSIX;
 use IO::Socket;  use IO::Socket;
Line 71  $DEBUG = 0;   # Set to 1 for annoyingly Line 75  $DEBUG = 0;   # Set to 1 for annoyingly
 $SIG{QUIT}=\&catchexception;  $SIG{QUIT}=\&catchexception;
 $SIG{__DIE__}=\&catchexception;  $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
 &status("Read access.conf");  &status("Read loncapa.conf and loncapa_apache.conf");
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
   my %perlvar=%{$perlvarref};
 while ($configline=<CONFIG>) {  undef $perlvarref;
     if ($configline =~ /PerlSetVar/) {  
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
         chomp($varvalue);  
         $perlvar{$varname}=$varvalue;  
     }  
 }  
 close(CONFIG);  
   
 # ----------------------------- Make sure this process is running from user=www  # ----------------------------- Make sure this process is running from user=www
 &status("Check user ID");  &status("Check user ID");
Line 175  $SIG{USR1} = \&USRMAN; Line 172  $SIG{USR1} = \&USRMAN;
 # And maintain the population.  # And maintain the population.
 while (1) {  while (1) {
     my $deadpid = wait; # Wait for the next child to die.      my $deadpid = wait; # Wait for the next child to die.
                                     # See who died and start new one                                  # See who died and start new one
                                   # or a signal (e.g. USR1 for restart).
                                   # if a signal, the wait will fail
                                   # This is ordinarily detected by
                                   # checking for the existence of the
                                   # pid index inthe children hash since
                                   # the return value from a failed wait is -1
                                   # which is an impossible PID.
     &status("Woke up");      &status("Woke up");
     my $skipping='';      my $skipping='';
   
Line 315  unless ( Line 319  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 395  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 411  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 430  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 471  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 480  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 514  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 539  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 579  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 685  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 {
Line 897  sub checkchildren { Line 874  sub checkchildren {
   
 sub USRMAN {  sub USRMAN {
     &logthis("USR1: Trying to establish connections again");      &logthis("USR1: Trying to establish connections again");
     %childatt=();      #
     &checkchildren();      #  It is really important not to just clear the childatt hash or we will
       #  lose all memory of the children.  What we really want to do is this:
       #  For each index where childatt is >= $childmaxattempts
       #  Zero the associated counter and do a make_child for the host.
       #  Regardles, the childatt entry is zeroed:
       my $host;
       foreach $host (keys %childatt) {
    if ($childatt{$host} >= $childmaxattempts) {
       $childatt{$host} = 0;
       &logthis("<font color=green>INFO: Restarting child for server: "
        .$host."</font>\n");
       make_new_child($host);
    }
    else {
       $childatt{$host} = 0;
    }
       }
       &checkchildren(); # See if any children are still dead...
 }  }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
Line 1043  sub status { Line 1037  sub status {
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     $status=$local.': '.$what;      $status=$local.': '.$what;
       $0='lonc: '.$what.' '.$local;
 }  }
   
   
Removed from v.1.36  
changed lines
  Added in v.1.43

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