Diff for /loncom/loncnew between versions 1.10 and 1.12

version 1.10, 2003/06/24 02:46:04 version 1.12, 2003/07/02 01:12:35
Line 46 Line 46
   
 # Change log:  # Change log:
 #    $Log$  #    $Log$
   #    Revision 1.12  2003/07/02 01:12:35  foxr
   #    - Add some debugging to killthemall
   #    - Add better error handling to LondReadable
   #    - Remove tick logging in the timer handler.
   #
   #    Revision 1.11  2003/06/25 01:54:44  foxr
   #    Fix more problems with transaction failure.
   #
 #    Revision 1.10  2003/06/24 02:46:04  foxr  #    Revision 1.10  2003/06/24 02:46:04  foxr
 #    Put a limit on  the number of times we'll retry a connection.  #    Put a limit on  the number of times we'll retry a connection.
 #    Start getting the signal stuff put in as well...note that need to get signals  #    Start getting the signal stuff put in as well...note that need to get signals
Line 68  use lib "/home/httpd/lib/perl/"; Line 76  use lib "/home/httpd/lib/perl/";
 use lib "/home/foxr/newloncapa/types";  use lib "/home/foxr/newloncapa/types";
 use Event qw(:DEFAULT );  use Event qw(:DEFAULT );
 use POSIX qw(:signal_h);  use POSIX qw(:signal_h);
   use POSIX;
 use IO::Socket;  use IO::Socket;
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Socket::UNIX;  use IO::Socket::UNIX;
Line 284  Invoked  each timer tick. Line 293  Invoked  each timer tick.
 sub Tick {  sub Tick {
     my $client;      my $client;
     ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);      ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
     Debug(6, "Tick");  
     Debug(6, "    Current connection count: ".$ConnectionCount);  
     foreach $client (keys %ActiveClients) {  
  Debug(7, "    Have client:  with id: ".$ActiveClients{$client});  
     }  
     # Is it time to prune connection count:      # Is it time to prune connection count:
   
   
Line 520  sub StartClientReply { Line 525  sub StartClientReply {
     my $Transaction   = shift;      my $Transaction   = shift;
     my $data     = shift;      my $data     = shift;
   
   
     my $Client   = $Transaction->getClient();      my $Client   = $Transaction->getClient();
   
     &Debug(8," Reply was: ".$data);      &Debug(8," Reply was: ".$data);
Line 558  sub FailTransaction { Line 564  sub FailTransaction {
     my $transaction = shift;      my $transaction = shift;
     Debug(1, "Failing transaction: ".$transaction->getRequest());      Debug(1, "Failing transaction: ".$transaction->getRequest());
     if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.      if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
  my $client  = $transcation->getClient();   my $client  = $transaction->getClient();
  Debug(1," Replying con_lost to ".$transaction->getRequest());   Debug(1," Replying con_lost to ".$transaction->getRequest());
  StartClientReply($client, "con_lost\n");   StartClientReply($transaction, "con_lost\n");
     }      }
   
 }  }
Line 713  sub LondReadable { Line 719  sub LondReadable {
     my $State = $Socket->GetState(); # All action depends on the state.      my $State = $Socket->GetState(); # All action depends on the state.
   
     SocketDump(6, $Socket);      SocketDump(6, $Socket);
       my $status = $Socket->Readable();
       &Debug(2, "Socket->Readable returned: $status");
   
     if($Socket->Readable() != 0) {      if($status != 0) {
  # bad return from socket read. Currently this means that   # bad return from socket read. Currently this means that
  # The socket has become disconnected. We fail the transaction.   # The socket has become disconnected. We fail the transaction.
   
Line 979  sub QueueDelayed { Line 987  sub QueueDelayed {
  my $Handle = IO::File->new($reqfile);   my $Handle = IO::File->new($reqfile);
  my $cmd    = <$Handle>;   my $cmd    = <$Handle>;
  chomp $cmd; # There may or may not be a newline...   chomp $cmd; # There may or may not be a newline...
  $cmd = $cmd."\ny"; # now for sure there's exactly one newline.   $cmd = $cmd."\n"; # now for sure there's exactly one newline.
  my $Transaction = LondTransaction->new($cmd);   my $Transaction = LondTransaction->new($cmd);
  $Transaction->SetDeferred($reqfile);   $Transaction->SetDeferred($reqfile);
  QueueTransaction($Transaction);   QueueTransaction($Transaction);
Line 1290  Called in response to a signal that caus Line 1298  Called in response to a signal that caus
   
 =cut  =cut
   
 =pod  
   
 sub SignalledToDeath {  sub SignalledToDeath {
       Debug(2,"Signalled to death!");
     my ($signal) = @_;      my ($signal) = @_;
     chomp($signal);      chomp($signal);
     Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "      Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "
Line 1300  sub SignalledToDeath { Line 1308  sub SignalledToDeath {
     LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "      LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
     ."\"$signal\"");      ."\"$signal\"");
     die("Signal abnormal end");      die("Signal abnormal end");
       exit 0;
   
 }  }
 =head2 ChildProcess  =head2 ChildProcess
Line 1316  sub ChildProcess { Line 1325  sub ChildProcess {
     $SIG{QUIT}  = \&SignalledToDeath;      $SIG{QUIT}  = \&SignalledToDeath;
     $SIG{HUP}   = IGNORE;      $SIG{HUP}   = IGNORE;
     $SIG{USR1}  = IGNORE;      $SIG{USR1}  = IGNORE;
     $SIG{INT}   = IGNORE;      $SIG{INT}   = DEFAULT;
     $SIG{CHLD}  = IGNORE;      $SIG{CHLD}  = IGNORE;
     $SIG{__DIE__}  = \&SignalledToDeath;      $SIG{__DIE__}  = \&SignalledToDeath;
   
Line 1343  sub ChildProcess { Line 1352  sub ChildProcess {
 #  Create a new child for host passed in:  #  Create a new child for host passed in:
   
 sub CreateChild {  sub CreateChild {
       my $sigset = POSIX::SigSet->new(SIGINT);
       sigprocmask(SIG_BLOCK, $sigset);
     my $host = shift;      my $host = shift;
     $RemoteHost = $host;      $RemoteHost = $host;
     Log("CRITICAL", "Forking server for ".$host);      Log("CRITICAL", "Forking server for ".$host);
     $pid          = fork;      $pid          = fork;
     if($pid) { # Parent      if($pid) { # Parent
  $ChildHash{$pid} = $RemoteHost;   $ChildHash{$pid} = $RemoteHost;
    sigprocmask(SIG_UNBLOCK, $sigset);
   
     } else { # child.      } else { # child.
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  ChildProcess;   $SIG{INT} = DEFAULT;
    sigprocmask(SIG_UNBLOCK, $sigset);
    ChildProcess; # Does not return.
     }      }
   
 }  }
Line 1407  while (! $HostIterator->end()) { Line 1422  while (! $HostIterator->end()) {
     CreateChild($hostentryref->[0]);      CreateChild($hostentryref->[0]);
     $HostIterator->next();      $HostIterator->next();
 }  }
   $RemoteHost = "Parent Server";
   
 # Maintain the population:  # Maintain the population:
   
Line 1415  ShowStatus("Parent keeping the flock"); Line 1431  ShowStatus("Parent keeping the flock");
 #  #
 #   Set up parent signals:  #   Set up parent signals:
 #  #
 $SIG{INT}  = &KillThemAll;  
 $SIG{TERM} = &KillThemAll;   $SIG{INT}  = \&KillThemAll;
   $SIG{TERM} = \&KillThemAll; 
   
   
 while(1) {  while(1) {
     $deadchild = wait();      $deadchild = wait();
Line 1429  while(1) { Line 1447  while(1) {
  CreateChild($deadhost);   CreateChild($deadhost);
     }      }
 }  }
   
   =pod
   
   =head1 KillThemAll
   
   Signal handler that kills all children by sending them a 
   SIGINT.  Responds to sigint and sigterm.
   
   =cut
   
 sub KillThemAll {  sub KillThemAll {
       Debug(2, "Kill them all!!");
       local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
       foreach $pid (keys %ChildHash) {
    my $serving = $ChildHash{$pid};
    Debug(2, "Killing lonc for $serving pid = $pid");
    ShowStatus("Killing lonc for $serving pid = $pid");
    Log("CRITICAL", "Killing lonc for $serving pid = $pid");
    kill('INT', $pid);
       }
       Log("CRITICAL", "Killing the master process.");
       exit
 }  }
   
   =pod
   
 =head1 Theory  =head1 Theory
   
 The event class is used to build this as a single process with an  The event class is used to build this as a single process with an

Removed from v.1.10  
changed lines
  Added in v.1.12


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