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

Diff for /loncom/loncnew between versions 1.18 and 1.34

version 1.18, 2003/08/06 09:52:29 version 1.34, 2003/12/11 23:18:37
Line 43 Line 43
 #    - Detect transmission timeouts.  #    - Detect transmission timeouts.
 #  #
   
 # Change log:  use strict;
 #    $Log$  
 #    Revision 1.18  2003/08/06 09:52:29  foxr  
 #    Also needed to remember to fail in-flight transactions if their sends fail.  
 #  
 #    Revision 1.17  2003/08/03 00:44:31  foxr  
 #    1. Correct handling of connection failure: Assume it means the host is  
 #       unreachable and fail all of the queued transactions.  Note that the  
 #       inflight transactions should fail on their own time due either to timeout  
 #       or send/receive failures.  
 #    2. Correct handling of logs for forced death signals.  Pull the signal  
 #       from the event watcher.  
 #  
 #    Revision 1.16  2003/07/29 02:33:05  foxr  
 #    Add SIGINT processing to child processes to toggle annoying trace mode  
 #    on/off.. will try to use this to isolate the compute boud process issue.  
 #  
 #    Revision 1.15  2003/07/15 02:07:05  foxr  
 #    Added code for lonc/lond transaction timeouts.  Who knows if it works right.  
 #    The intent is for a timeout to fail any transaction in progress and kill  
 #    off the sockt that timed out.  
 #  
 #    Revision 1.14  2003/07/03 02:10:18  foxr  
 #    Get all of the signals to work correctly.  
 #  
 #    Revision 1.13  2003/07/02 01:31:55  foxr  
 #    Added kill -HUP logic (restart).  
 #  
 #    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  
 #    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  
 #    going or else 6the client will permanently give up on dead servers.  
 #  
 #    Revision 1.9  2003/06/13 02:38:43  foxr  
 #    Add logging in 'expected format'  
 #  
 #    Revision 1.8  2003/06/11 02:04:35  foxr  
 #    Support delayed transactions... this is done uniformly by encapsulating  
 #    transactions in an object ... a LondTransaction that is implemented by  
 #    LondTransaction.pm  
 #  
 #    Revision 1.7  2003/06/03 01:59:39  foxr  
 #    complete coding to support deferred transactions.  
 #  
 #  
   
 use lib "/home/httpd/lib/perl/";  use lib "/home/httpd/lib/perl/";
 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 POSIX;
Line 115  use LONCAPA::HashIterator; Line 66  use LONCAPA::HashIterator;
 #  #
 #   Disable all signals we might receive from outside for now.  #   Disable all signals we might receive from outside for now.
 #  #
 #$SIG{QUIT}  = IGNORE;  
 #$SIG{HUP}   = IGNORE;  
 #$SIG{USR1}  = IGNORE;  
 #$SIG{INT}   = IGNORE;  
 #$SIG{CHLD}  = IGNORE;  
 #$SIG{__DIE__}  = IGNORE;  
   
   
 # Read the httpd configuration file to get perl variables  # Read the httpd configuration file to get perl variables
Line 133  my %perlvar    = %{$perlvarref}; Line 78  my %perlvar    = %{$perlvarref};
 #  parent and shared variables.  #  parent and shared variables.
   
 my %ChildHash; # by pid -> host.  my %ChildHash; # by pid -> host.
   my %HostToPid; # By host -> pid.
   my %HostHash; # by loncapaname -> IP.
   
   
 my $MaxConnectionCount = 10; # Will get from config later.  my $MaxConnectionCount = 10; # Will get from config later.
 my $ClientConnection = 0; # Uniquifier for client events.  my $ClientConnection = 0; # Uniquifier for client events.
   
 my $DebugLevel = 0;  my $DebugLevel = 0;
 my $NextDebugLevel= 10; # So Sigint can toggle this.  my $NextDebugLevel= 2; # So Sigint can toggle this.
 my $IdleTimeout= 3600; # Wait an hour before pruning connections.  my $IdleTimeout= 3600; # Wait an hour before pruning connections.
   
 #  #
 #  The variables below are only used by the child processes.  #  The variables below are only used by the child processes.
 #  #
 my $RemoteHost; # Name of host child is talking to.  my $RemoteHost; # Name of host child is talking to.
 my $UnixSocketDir= "/home/httpd/sockets";   my $UnixSocketDir= $perlvar{'lonSockDir'};
 my $IdleConnections = Stack->new(); # Set of idle connections  my $IdleConnections = Stack->new(); # Set of idle connections
 my %ActiveConnections; # Connections to the remote lond.  my %ActiveConnections; # Connections to the remote lond.
 my %ActiveTransactions; # LondTransactions in flight.  my %ActiveTransactions; # LondTransactions in flight.
Line 156  my $ConnectionCount = 0; Line 103  my $ConnectionCount = 0;
 my $IdleSeconds     = 0; # Number of seconds idle.  my $IdleSeconds     = 0; # Number of seconds idle.
 my $Status          = ""; # Current status string.  my $Status          = ""; # Current status string.
 my $RecentLogEntry  = "";  my $RecentLogEntry  = "";
 my $ConnectionRetries=5; # Number of connection retries allowed.  my $ConnectionRetries=2; # Number of connection retries allowed.
 my $ConnectionRetriesLeft=5; # Number of connection retries remaining.  my $ConnectionRetriesLeft=2; # Number of connection retries remaining.
   
 #  #
 #   The hash below gives the HTML format for log messages  #   The hash below gives the HTML format for log messages
Line 255  sub GetPeername { Line 202  sub GetPeername {
     my $peerip;      my $peerip;
     if($AdrFamily == AF_INET) {      if($AdrFamily == AF_INET) {
  ($peerport, $peerip) = sockaddr_in($peer);   ($peerport, $peerip) = sockaddr_in($peer);
  my $peername    = gethostbyaddr($iaddr, $AdrFamily);   my $peername    = gethostbyaddr($peerip, $AdrFamily);
  return $peername;   return $peername;
     } elsif ($AdrFamily == AF_UNIX) {      } elsif ($AdrFamily == AF_UNIX) {
  my $peerfile;   my $peerfile;
Line 276  sub Debug { Line 223  sub Debug {
     my $level   = shift;      my $level   = shift;
     my $message = shift;      my $message = shift;
     if ($level <= $DebugLevel) {      if ($level <= $DebugLevel) {
  Log("INFO", "-Debug- $message host = $RemotHost");   Log("INFO", "-Debug- $message host = $RemoteHost");
     }      }
 }  }
   
Line 316  sub ShowStatus { Line 263  sub ShowStatus {
 sub SocketTimeout {  sub SocketTimeout {
     my $Socket = shift;      my $Socket = shift;
           
     KillSocket($Socket);      KillSocket($Socket); # A transaction timeout also counts as
                                   # a connection failure:
       $ConnectionRetriesLeft--;
 }  }
   
 =pod  =pod
Line 330  Invoked  each timer tick. Line 279  Invoked  each timer tick.
   
 sub Tick {  sub Tick {
     my $client;      my $client;
     ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);      if($ConnectionRetriesLeft > 0) {
    ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
      ." Retries remaining: ".$ConnectionRetriesLeft);
       } else {
    ShowStatus(GetServerHost()." >> DEAD <<");
       }
     # Is it time to prune connection count:      # Is it time to prune connection count:
   
   
Line 339  sub Tick { Line 292  sub Tick {
        ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?         ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
  $IdleSeconds++;   $IdleSeconds++;
  if($IdleSeconds > $IdleTimeout) { # Prune a connection...   if($IdleSeconds > $IdleTimeout) { # Prune a connection...
     $Socket = $IdleConnections->pop();      my $Socket = $IdleConnections->pop();
     KillSocket($Socket);      KillSocket($Socket);
  }   }
     } else {      } else {
Line 348  sub Tick { Line 301  sub Tick {
     #      #
     #  For each inflight transaction, tick down its timeout counter.      #  For each inflight transaction, tick down its timeout counter.
     #      #
     foreach $item (keys %ActiveTransactions) {      foreach my $item (keys %ActiveTransactions) {
  my $Socket = $ActiveTransactions{$item}->getServer();   my $Socket = $ActiveTransactions{$item}->getServer();
  $Socket->Tick();   $Socket->Tick();
     }      }
       foreach my $item (keys %ActiveConnections) {
    my $State = $ActiveConnections{$item}->data->GetState();
    if ($State ne 'Idle' && $State ne 'SendingRequest' &&
       $State ne 'ReceivingReply') {
       Debug(5,"Ticking Socket $State $item");
       $ActiveConnections{$item}->data->Tick();
    }
       }
     # Do we have work in the queue, but no connections to service them?      # Do we have work in the queue, but no connections to service them?
     # If so, try to make some new connections to get things going again.      # If so, try to make some new connections to get things going again.
     #      #
Line 361  sub Tick { Line 322  sub Tick {
  if ($ConnectionRetriesLeft > 0) {   if ($ConnectionRetriesLeft > 0) {
     my $Connections = ($Requests <= $MaxConnectionCount) ?      my $Connections = ($Requests <= $MaxConnectionCount) ?
  $Requests : $MaxConnectionCount;   $Requests : $MaxConnectionCount;
     Debug(1,"Work but no connections, start ".$Connections." of them");      Debug(5,"Work but no connections, start ".$Connections." of them");
     for ($i =0; $i < $Connections; $i++) {      my $successCount = 0;
  MakeLondConnection();      for (my $i =0; $i < $Connections; $i++) {
    $successCount += MakeLondConnection();
       }
       if($successCount == 0) { # All connections failed:
    Debug(5,"Work in queue failed to make any connectiouns\n");
    EmptyQueue(); # Fail pending transactions with con_lost.
     }      }
  } else {   } else {
     Debug(1,"Work in queue, but gave up on connections..flushing\n");      ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
       Debug(5,"Work in queue, but gave up on connections..flushing\n");
     EmptyQueue(); # Connections can't be established.      EmptyQueue(); # Connections can't be established.
  }   }
                 
Line 391  Trigger disconnections of idle sockets. Line 358  Trigger disconnections of idle sockets.
   
 sub SetupTimer {  sub SetupTimer {
     Debug(6, "SetupTimer");      Debug(6, "SetupTimer");
     Event->timer(interval => 1, debug => 1, cb => \&Tick );      Event->timer(interval => 1, cb => \&Tick );
 }  }
   
 =pod  =pod
Line 413  sub ServerToIdle { Line 380  sub ServerToIdle {
     my $Socket   = shift; # Get the socket.      my $Socket   = shift; # Get the socket.
     delete($ActiveTransactions{$Socket}); # Server has no transaction      delete($ActiveTransactions{$Socket}); # Server has no transaction
   
     &Debug(6, "Server to idle");      &Debug(5, "Server to idle");
   
     #  If there's work to do, start the transaction:      #  If there's work to do, start the transaction:
   
     $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction      my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
     unless($reqdata eq undef)  {      if ($reqdata ne undef)  {
  Debug(9, "Queue gave request data: ".$reqdata->getRequest());   Debug(5, "Queue gave request data: ".$reqdata->getRequest());
  &StartRequest($Socket,  $reqdata);   &StartRequest($Socket,  $reqdata);
   
     } else {      } else {
   
     #  There's no work waiting, so push the server to idle list.      #  There's no work waiting, so push the server to idle list.
  &Debug(8, "No new work requests, server connection going idle");   &Debug(5, "No new work requests, server connection going idle");
  $IdleConnections->push($Socket);   $IdleConnections->push($Socket);
     }      }
 }  }
Line 471  sub ClientWritable { Line 438  sub ClientWritable {
  # request.   # request.
   
  &Debug(9,"Send result is ".$result." Defined: ".defined($result));   &Debug(9,"Send result is ".$result." Defined: ".defined($result));
  if(defined($result)) {   if($result ne undef) {
     &Debug(9, "send result was defined");      &Debug(9, "send result was defined");
     if($result == length($Data)) { # Entire string sent.      if($result == length($Data)) { # Entire string sent.
  &Debug(9, "ClientWritable data all written");   &Debug(9, "ClientWritable data all written");
Line 542  The transaction that is being completed. Line 509  The transaction that is being completed.
 =cut  =cut
   
 sub CompleteTransaction {  sub CompleteTransaction {
     &Debug(6,"Complete transaction");      &Debug(5,"Complete transaction");
     my $Socket = shift;      my $Socket = shift;
     my $Transaction = shift;      my $Transaction = shift;
   
Line 551  sub CompleteTransaction { Line 518  sub CompleteTransaction {
  StartClientReply($Transaction, $data);   StartClientReply($Transaction, $data);
     } else { # Delete deferred transaction file.      } else { # Delete deferred transaction file.
  Log("SUCCESS", "A delayed transaction was completed");   Log("SUCCESS", "A delayed transaction was completed");
  LogPerm("S:$Client:".$Transaction->getRequest());   LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
  unlink $Transaction->getFile();   unlink $Transaction->getFile();
     }      }
 }  }
Line 581  sub StartClientReply { Line 548  sub StartClientReply {
     &Debug(8," Reply was: ".$data);      &Debug(8," Reply was: ".$data);
     my $Serial         = $ActiveClients{$Client};      my $Serial         = $ActiveClients{$Client};
     my $desc           = sprintf("Connection to lonc client %d",      my $desc           = sprintf("Connection to lonc client %d",
   
  $Serial);   $Serial);
     Event->io(fd       => $Client,      Event->io(fd       => $Client,
       poll     => "w",        poll     => "w",
Line 619  sub FailTransaction { Line 585  sub FailTransaction {
  Debug(1," Replying con_lost to ".$transaction->getRequest());   Debug(1," Replying con_lost to ".$transaction->getRequest());
  StartClientReply($transaction, "con_lost\n");   StartClientReply($transaction, "con_lost\n");
     }      }
       if($ConnectionRetriesLeft <= 0) {
    Log("CRITICAL", "Host marked dead: ".GetServerHost());
       }
   
 }  }
   
Line 630  sub FailTransaction { Line 599  sub FailTransaction {
   
 =cut  =cut
 sub EmptyQueue {  sub EmptyQueue {
       $ConnectionRetriesLeft--; # Counts as connection failure too.
     while($WorkQueue->Count()) {      while($WorkQueue->Count()) {
  my $request = $WorkQueue->dequeue(); # This is a transaction   my $request = $WorkQueue->dequeue(); # This is a transaction
  FailTransaction($request);   FailTransaction($request);
Line 644  Close all connections open on lond prior Line 614  Close all connections open on lond prior
   
 =cut  =cut
 sub CloseAllLondConnections {  sub CloseAllLondConnections {
     foreach $Socket (keys %ActiveConnections) {      foreach my $Socket (keys %ActiveConnections) {
  KillSocket($Socket);   KillSocket($Socket);
     }      }
 }  }
Line 696  sub KillSocket { Line 666  sub KillSocket {
     #  work queue, the work all gets failed with con_lost.      #  work queue, the work all gets failed with con_lost.
     #      #
     if($ConnectionCount == 0) {      if($ConnectionCount == 0) {
  EmptyQueue;   EmptyQueue();
     }      }
 }  }
   
Line 765  sub LondReadable { Line 735  sub LondReadable {
     my $Socket     = $Watcher->data;      my $Socket     = $Watcher->data;
     my $client     = undef;      my $client     = undef;
   
     &Debug(6,"LondReadable called state = ".$State);      &Debug(6,"LondReadable called state = ".$Socket->GetState());
   
   
     my $State = $Socket->GetState(); # All action depends on the state.      my $State = $Socket->GetState(); # All action depends on the state.
Line 786  sub LondReadable { Line 756  sub LondReadable {
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket);   KillSocket($Socket);
    $ConnectionRetriesLeft--;       # Counts as connection failure
  return;   return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 819  sub LondReadable { Line 790  sub LondReadable {
     } elsif ($State eq "Idle") {      } elsif ($State eq "Idle") {
  # If necessary, complete a transaction and then go into the   # If necessary, complete a transaction and then go into the
  # idle queue.   # idle queue.
    #  Note that a trasition to idle indicates a live lond
    # on the other end so reset the connection retries.
    #
    $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
  $Watcher->cancel();   $Watcher->cancel();
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     Debug(8,"Completing transaction!!");      Debug(5,"Completing transaction!!");
     CompleteTransaction($Socket,       CompleteTransaction($Socket, 
  $ActiveTransactions{$Socket});   $ActiveTransactions{$Socket});
  } else {   } else {
Line 1031  sub QueueDelayed { Line 1006  sub QueueDelayed {
     Debug(4, "Delayed path: ".$path);      Debug(4, "Delayed path: ".$path);
     opendir(DIRHANDLE, $path);      opendir(DIRHANDLE, $path);
           
     @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;      my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
     Debug(4, "Got ".$alldelayed." delayed files");  
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     my $dfname;      my $dfname;
     my $reqfile;      my $reqfile;
Line 1069  sub MakeLondConnection { Line 1043  sub MakeLondConnection {
     my $Connection = LondConnection->new(&GetServerHost(),      my $Connection = LondConnection->new(&GetServerHost(),
  &GetServerPort());   &GetServerPort());
   
     if($Connection == undef) { # Needs to be more robust later.      if($Connection eq undef) { # Needs to be more robust later.
  Log("CRITICAL","Failed to make a connection with lond.");   Log("CRITICAL","Failed to make a connection with lond.");
  $ConnectionRetriesLeft--;   $ConnectionRetriesLeft--;
  return 0; # Failure.   return 0; # Failure.
     }  else {      }  else {
  $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count  
  # The connection needs to have writability    # The connection needs to have writability 
  # monitored in order to send the init sequence   # monitored in order to send the init sequence
  # that starts the whole authentication/key   # that starts the whole authentication/key
  # exchange underway.   # exchange underway.
  #   #
  my $Socket = $Connection->GetSocket();   my $Socket = $Connection->GetSocket();
  if($Socket == undef) {   if($Socket eq undef) {
     die "did not get a socket from the connection";      die "did not get a socket from the connection";
  } else {   } else {
     &Debug(9,"MakeLondConnection got socket: ".$Socket);      &Debug(9,"MakeLondConnection got socket: ".$Socket);
  }   }
   
    $Connection->SetTimeoutCallback(\&SocketTimeout);
  $event = Event->io(fd       => $Socket,  
    my $event = Event->io(fd       => $Socket,
    poll     => 'w',     poll     => 'w',
    cb       => \&LondWritable,     cb       => \&LondWritable,
    data     => $Connection,     data     => $Connection,
Line 1144  sub StartRequest { Line 1119  sub StartRequest {
     $ActiveTransactions{$Lond} = $Request;      $ActiveTransactions{$Lond} = $Request;
   
     $Lond->InitiateTransaction($Request->getRequest());      $Lond->InitiateTransaction($Request->getRequest());
     $event = Event->io(fd      => $Socket,      my $event = Event->io(fd      => $Socket,
        poll    => "w",         poll    => "w",
        cb      => \&LondWritable,         cb      => \&LondWritable,
        data    => $Lond,         data    => $Lond,
Line 1183  sub QueueTransaction { Line 1158  sub QueueTransaction {
   
     my $LondSocket    = $IdleConnections->pop();      my $LondSocket    = $IdleConnections->pop();
     if(!defined $LondSocket) { # Need to queue request.      if(!defined $LondSocket) { # Need to queue request.
  Debug(8,"Must queue...");   Debug(5,"Must queue...");
  $WorkQueue->enqueue($requestData);   $WorkQueue->enqueue($requestData);
  if($ConnectionCount < $MaxConnectionCount) {   if($ConnectionCount < $MaxConnectionCount) {
     Debug(4,"Starting additional lond connection");      if($ConnectionRetriesLeft > 0) {
     if(MakeLondConnection() == 0) {   Debug(5,"Starting additional lond connection");
  EmptyQueue(); # Fail transactions, can't make connection.   if(MakeLondConnection() == 0) {
       EmptyQueue(); # Fail transactions, can't make connection.
    }
       } else {
    ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
    EmptyQueue(); # It's worse than that ... he's dead Jim.
     }      }
  }   }
     } else { # Can start the request:      } else { # Can start the request:
Line 1220  sub ClientRequest { Line 1200  sub ClientRequest {
     my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);      my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
     Debug(8, "rcv:  data length = ".length($thisread)      Debug(8, "rcv:  data length = ".length($thisread)
   ." read =".$thisread);    ." read =".$thisread);
     unless (defined $rv && length($thisread)) {      unless (defined $rv  && length($thisread)) {
  # Likely eof on socket.   # Likely eof on socket.
  Debug(5,"Client Socket closed on lonc for ".$RemoteHost);   Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
  close($socket);   close($socket);
Line 1354  sub SetupLoncListener { Line 1334  sub SetupLoncListener {
 Child USR1 signal handler to report the most recent status  Child USR1 signal handler to report the most recent status
 into the status file.  into the status file.
   
   We also use this to reset the retries count in order to allow the
   client to retry connections with a previously dead server.
 =cut  =cut
 sub ChildStatus {  sub ChildStatus {
     my $event = shift;      my $event = shift;
Line 1364  sub ChildStatus { Line 1346  sub ChildStatus {
     my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");      my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
     print $fh $$."\t".$RemoteHost."\t".$Status."\t".      print $fh $$."\t".$RemoteHost."\t".$Status."\t".
  $RecentLogEntry."\n";   $RecentLogEntry."\n";
       $ConnectionRetriesLeft = $ConnectionRetries;
 }  }
   
 =pod  =pod
Line 1459  sub CreateChild { Line 1442  sub CreateChild {
     my $host = shift;      my $host = shift;
     $RemoteHost = $host;      $RemoteHost = $host;
     Log("CRITICAL", "Forking server for ".$host);      Log("CRITICAL", "Forking server for ".$host);
     $pid          = fork;      my $pid          = fork;
     if($pid) { # Parent      if($pid) { # Parent
  $RemoteHost = "Parent";   $RemoteHost = "Parent";
  $ChildHash{$pid} = $RemoteHost;   $ChildHash{$pid} = $host;
    $HostToPid{$host}= $pid;
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
   
     } else { # child.      } else { # child.
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  $SIG{INT} = DEFAULT;   $SIG{INT} = 'DEFAULT';
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
  ChildProcess; # Does not return.   ChildProcess; # Does not return.
     }      }
Line 1504  if ($childpid != 0) { Line 1488  if ($childpid != 0) {
 #  #
   
 ShowStatus("Parent writing pid file:");  ShowStatus("Parent writing pid file:");
 $execdir = $perlvar{'lonDaemons'};  my $execdir = $perlvar{'lonDaemons'};
 open (PIDSAVE, ">$execdir/logs/lonc.pid");  open (PIDSAVE, ">$execdir/logs/lonc.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
Line 1520  ShowStatus("Forking node servers"); Line 1504  ShowStatus("Forking node servers");
   
 Log("CRITICAL", "--------------- Starting children ---------------");  Log("CRITICAL", "--------------- Starting children ---------------");
   
   LondConnection::ReadConfig;               # Read standard config files.
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
 while (! $HostIterator->end()) {  while (! $HostIterator->end()) {
   
     $hostentryref = $HostIterator->get();      my $hostentryref = $HostIterator->get();
     CreateChild($hostentryref->[0]);      CreateChild($hostentryref->[0]);
       $HostHash{$hostentryref->[0]} = $hostentryref->[4];
     $HostIterator->next();      $HostIterator->next();
 }  }
 $RemoteHost = "Parent Server";  $RemoteHost = "Parent Server";
Line 1541  $SIG{INT}  = \&Terminate; Line 1527  $SIG{INT}  = \&Terminate;
 $SIG{TERM} = \&Terminate;   $SIG{TERM} = \&Terminate; 
 $SIG{HUP}  = \&Restart;  $SIG{HUP}  = \&Restart;
 $SIG{USR1} = \&CheckKids;   $SIG{USR1} = \&CheckKids; 
   $SIG{USR2} = \&UpdateKids; # LonManage update request.
   
 while(1) {  while(1) {
     $deadchild = wait();      my $deadchild = wait();
     if(exists $ChildHash{$deadchild}) { # need to restart.      if(exists $ChildHash{$deadchild}) { # need to restart.
  $deadhost = $ChildHash{$deadchild};   my $deadhost = $ChildHash{$deadchild};
    delete($HostToPid{$deadhost});
  delete($ChildHash{$deadchild});   delete($ChildHash{$deadchild});
  Log("WARNING","Lost child pid= ".$deadchild.   Log("WARNING","Lost child pid= ".$deadchild.
       "Connected to host ".$deadhost);        "Connected to host ".$deadhost);
Line 1575  sub CheckKids { Line 1563  sub CheckKids {
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "LONC status $local - parent $$ \n\n";      print $fh "LONC status $local - parent $$ \n\n";
     foreach $pid (keys %ChildHash) {      foreach my $pid (keys %ChildHash) {
  Debug(2, "Sending USR1 -> $pid");   Debug(2, "Sending USR1 -> $pid");
  kill 'USR1' => $pid; # Tell Child to report status.   kill 'USR1' => $pid; # Tell Child to report status.
  sleep 1; # Wait so file doesn't intermix.   sleep 1; # Wait so file doesn't intermix.
Line 1584  sub CheckKids { Line 1572  sub CheckKids {
   
 =pod  =pod
   
   =head1  UpdateKids
   
   parent's SIGUSR2 handler.  This handler:
   
   =item
   
   Rereads the hosts file.
   
   =item
    
   Kills off (via sigint) children for hosts that have disappeared.
   
   =item
   
   QUITs  children for hosts that already exist (this just forces a status display
   and resets the connection retry count for that host.
   
   =item
   
   Starts new children for hosts that have been added to the hosts.tab file since
   the start of the master program and maintains them.
   
   =cut
   
   sub UpdateKids {
   
       Log("INFO", "Updating connections via SIGUSR2");
   
       #  Just in case we need to kill our own lonc, we wait a few seconds to
       #  give it a chance to receive and relay lond's response to the 
       #  re-init command.
       #
   
       sleep(2); # Wait a couple of seconds.
   
       my %hosts;                   # Indexed by loncapa hostname, value=ip.
       
       # Need to re-read  the host table:
       
       
       LondConnection::ReadConfig();
       my $I = LondConnection::GetHostIterator;
       while (! $I->end()) {
    my $item = $I->get();
    $hosts{$item->[0]} = $item->[4];
    $I->next();
       }
   
       #  The logic below is written for clarity not for efficiency.
       #  Since I anticipate that this function is only rarely called, that's
       #  appropriate.  There are certainly ways to combine the loops below,
       #  and anyone wishing to obscure the logic is welcome to go for it.
       #  Note that we don't re-direct sigchild.  Instead we do what's needed
       #  to the data structures that keep track of children to ensure that
       #  when sigchild is honored, no new child is born.
       #
   
       #  For each existing child; if it's host doesn't exist, kill the child.
   
       foreach my $child (keys %ChildHash) {
    my $oldhost = $ChildHash{$child};
    if (!(exists $hosts{$oldhost})) {
       Log("CRITICAL", "Killing child for $oldhost  host no longer exists");
       delete $ChildHash{$child};
       delete $HostToPid{$oldhost};
       kill 'QUIT' => $child;
    }
       }
       # For each remaining existing child; if it's host's ip has changed,
       # Restart the child on the new IP.
   
       foreach my $child (keys %ChildHash) {
    my $oldhost = $ChildHash{$child};
    my $oldip   = $HostHash{$oldhost};
    if ($hosts{$oldhost} ne $oldip) {
   
       # kill the old child.
   
       Log("CRITICAL", "Killing child for $oldhost host ip has changed...");
       delete $ChildHash{$child};
       delete $HostToPid{$oldhost};
       kill 'QUIT' => $child;
   
       # Do the book-keeping needed to start a new child on the
       # new ip.
   
       $HostHash{$oldhost} = $hosts{$oldhost};
       CreateChild($oldhost);
    }
       }
       # Finally, for each new host, not in the host hash, create a
       # enter the host and create a new child.
       # Force a status display of any existing process.
   
       foreach my $host (keys %hosts) {
    if(!(exists $HostHash{$host})) {
       Log("INFO", "New host $host discovered in hosts.tab...");
       $HostHash{$host} = $hosts{$host};
       CreateChild($host);
    } else {
       kill 'HUP' => $HostToPid{$host};    # status display.
    }
       }
   }
   
   
   =pod
   
 =head1 Restart  =head1 Restart
   
 Signal handler for HUP... all children are killed and  Signal handler for HUP... all children are killed and
Line 1593  the config file. Line 1689  the config file.
 =cut  =cut
   
 sub Restart {  sub Restart {
     KillThemAll; # First kill all the children.      &KillThemAll; # First kill all the children.
     Log("CRITICAL", "Restarting");      Log("CRITICAL", "Restarting");
     my $execdir = $perlvar{'lonDaemons'};      my $execdir = $perlvar{'lonDaemons'};
     unlink("$execdir/logs/lonc.pid");      unlink("$execdir/logs/lonc.pid");
     exec("$execdir/lonc");      exec("$execdir/loncnew");
 }  }
   
 =pod  =pod
Line 1612  SIGHUP.  Responds to sigint and sigterm. Line 1708  SIGHUP.  Responds to sigint and sigterm.
 sub KillThemAll {  sub KillThemAll {
     Debug(2, "Kill them all!!");      Debug(2, "Kill them all!!");
     local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.      local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
     foreach $pid (keys %ChildHash) {      foreach my $pid (keys %ChildHash) {
  my $serving = $ChildHash{$pid};   my $serving = $ChildHash{$pid};
  Debug(2, "Killing lonc for $serving pid = $pid");   Debug(2, "Killing lonc for $serving pid = $pid");
  ShowStatus("Killing lonc for $serving pid = $pid");   ShowStatus("Killing lonc for $serving pid = $pid");
Removed from v.1.18  
changed lines
  Added in v.1.34

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