loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.41 and 1.90

-version 1.41, 2004/02/09 13:39:28
+version 1.90, 2010/12/20 11:15:51
  Line 60  use LONCAPA::Stack;
  use LONCAPA::LondConnection;
  use LONCAPA::LondTransaction;
  use LONCAPA::Configuration;
- use LONCAPA::HashIterator;
+ use Fcntl qw(:flock);
  # Read the httpd configuration file to get perl variables
  Line 72  my %perlvar    = %{$perlvarref};
  #
  #  parent and shared variables.
- my %ChildHash;			# by pid -> host.
+ my %ChildPid;			# by pid -> host.
- my %HostToPid;			# By host -> pid.
+ my %ChildHost;			# by host.
- my %HostHash;			# by loncapaname -> IP.
+ my %listening_to;		# Socket->host table for who the parent
+                                 # is listening to.
+ my %parent_dispatchers;         # host-> listener watcher events.
+ my %parent_handlers;		# Parent signal handlers...
  my $MaxConnectionCount = 10;	# Will get from config later.
  my $ClientConnection = 0;	# Uniquifier for client events.
  my $DebugLevel = 0;
  my $NextDebugLevel= 2;		# So Sigint can toggle this.
- my $IdleTimeout= 3600;		# Wait an hour before pruning connections.
+ my $IdleTimeout= 7200;		# Wait two hours before pruning connections.
  my $LogTransactions = 0;	# When True, all transactions/replies get logged.
+ my $executable      = $0;	# Get the full path to me.
  #
  #  The variables below are only used by the child processes.
  #
  my $RemoteHost;			# Name of host child is talking to.
+ my $RemoteHostId;		# default lonid of host child is talking to.
+ my @all_host_ids;
  my $UnixSocketDir= $perlvar{'lonSockDir'};
  my $IdleConnections = Stack->new(); # Set of idle connections
  my %ActiveConnections;		# Connections to the remote lond.
- Line 100  my $ConnectionCount = 0;
+ Line 106  my $ConnectionCount = 0;
  my $IdleSeconds     = 0;	# Number of seconds idle.
  my $Status          = "";	# Current status string.
  my $RecentLogEntry  = "";
- my $ConnectionRetries=2;	# Number of connection retries allowed.
+ my $ConnectionRetries=5;	# Number of connection retries allowed.
- my $ConnectionRetriesLeft=2;	# Number of connection retries remaining.
+ my $ConnectionRetriesLeft=5;	# Number of connection retries remaining.
  my $LondVersion     = "unknown"; # Version of lond we talk with.
+ my $KeyMode         = "";       # e.g. ssl, local, insecure from last connect.
+ my $LondConnecting  = 0;       # True when a connection is being built.
+ my $I_am_child      = 0;	# True if this is the child process.
  #
  #   The hash below gives the HTML format for log messages
- Line 110  my $LondVersion     = "unknown"; # Versi
+ Line 122  my $LondVersion     = "unknown"; # Versi
  #
  my %LogFormats;
- $LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
+ $LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
- $LogFormats{"SUCCESS"}  = "<font color=green>SUCCESS: %s</font>";
+ $LogFormats{"SUCCESS"}  = "<font color='green'>SUCCESS: %s</font>";
- $LogFormats{"INFO"}     = "<font color=yellow>INFO: %s</font>";
+ $LogFormats{"INFO"}     = "<font color='yellow'>INFO: %s</font>";
- $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";
+ $LogFormats{"WARNING"}  = "<font color='blue'>WARNING: %s</font>";
  $LogFormats{"DEFAULT"}  = " %s ";
+ #  UpdateStatus;
+ #    Update the idle status display to show how many connections
+ #    are left, retries and other stuff.
+ #
+ sub UpdateStatus {
+     if ($ConnectionRetriesLeft > 0) {
+ 	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
+ 		   ." Retries remaining: ".$ConnectionRetriesLeft
+ 		   ." ($KeyMode)");
+     } else {
+ 	ShowStatus(GetServerHost()." >> DEAD <<");
+     }
+ }
  =pod
- Line 125  $LogFormats{"DEFAULT"}  = " %s ";
+ Line 151  $LogFormats{"DEFAULT"}  = " %s ";
  Makes an entry into the permanent log file.
  =cut
  sub LogPerm {
      my $message=shift;
      my $execdir=$perlvar{'lonDaemons'};
      my $now=time;
      my $local=localtime($now);
      my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
+     chomp($message);
      print $fh "$now:$message:$local\n";
  }
- Line 156  host and the time will be formatted into
+ Line 184  host and the time will be formatted into
  =cut
  sub Log {
-     my $severity = shift;
-     my $message  = shift;
+     my ($severity, $message) = @_;
      if(!$LogFormats{$severity}) {
  	$severity = "DEFAULT";
      }
- Line 170  sub Log {
+ Line 198  sub Log {
      my $now   = time;
      my $local = localtime($now);
      my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
-     my $finalformat = $finalformat.$format."\n";
+     $finalformat = $finalformat.$format."\n";
      # open the file and put the result.
- Line 193  Returns the name of the host that a sock
+ Line 221  Returns the name of the host that a sock
  =cut
  sub GetPeername {
-     my $connection = shift;
-     my $AdrFamily  = shift;
+     my ($connection, $AdrFamily) = @_;
      my $peer       = $connection->peername();
      my $peerport;
      my $peerip;
- Line 217  Invoked to issue a debug message.
+ Line 247  Invoked to issue a debug message.
  =cut
  sub Debug {
-     my $level   = shift;
-     my $message = shift;
+     my ($level, $message) = @_;
      if ($level <= $DebugLevel) {
  	Log("INFO", "-Debug- $message host = $RemoteHost");
      }
  }
  sub SocketDump {
-     my $level = shift;
-     my $socket= shift;
+     my ($level, $socket) = @_;
      if($level <= $DebugLevel) {
- 	$socket->Dump();
+ 	$socket->Dump(-1);	# Ensure it will get dumped.
      }
  }
- Line 240  sub SocketDump {
+ Line 272  sub SocketDump {
   and as what we return in a SIGUSR1
  =cut
  sub ShowStatus {
      my $state = shift;
      my $now = time;
- Line 250  sub ShowStatus {
+ Line 283  sub ShowStatus {
  =pod
- =head 2 SocketTimeout
+ =head2 SocketTimeout
      Called when an action on the socket times out.  The socket is
     destroyed and any active transaction is failed.
  =cut
  sub SocketTimeout {
      my $Socket = shift;
      Log("WARNING", "A socket timeout was detected");
-     Debug(0, " SocketTimeout called: ");
+     Debug(5, " SocketTimeout called: ");
-     $Socket->Dump();
+     $Socket->Dump(0);
+     if(exists($ActiveTransactions{$Socket})) {
+ 	FailTransaction($ActiveTransactions{$Socket});
+     }
      KillSocket($Socket);	# A transaction timeout also counts as
                                  # a connection failure:
      $ConnectionRetriesLeft--;
+     if($ConnectionRetriesLeft <= 0) {
+ 	Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
+ 	$LondConnecting = 0;
+     }
+ }
+ #
+ #   This function should be called by the child in all cases where it must
+ #   exit.  The child process must create a lock file for the AF_UNIX socket
+ #   in order to prevent connection requests from lonnet in the time between
+ #   process exit and the parent picking up the listen again.
+ #
+ # Parameters:
+ #     exit_code           - Exit status value, however see the next parameter.
+ #     message             - If this optional parameter is supplied, the exit
+ #                           is via a die with this message.
+ #
+ sub child_exit {
+     my ($exit_code, $message) = @_;
+     # Regardless of how we exit, we may need to do the lock thing:
+     #
+     #  Create a lock file since there will be a time window
+     #  between our exit and the parent's picking up the listen
+     #  during which no listens will be done on the
+     #  lonnet client socket.
+     #
+     my $lock_file = &GetLoncSocketPath().".lock";
+     open(LOCK,">$lock_file");
+     print LOCK "Contents not important";
+     close(LOCK);
+     unlink(&GetLoncSocketPath());
+     if ($message) {
+ 	die($message);
+     } else {
+ 	exit($exit_code);
+     }
  }
  #----------------------------- Timer management ------------------------
- Line 278  Invoked  each timer tick.
+ Line 355  Invoked  each timer tick.
  sub Tick {
+     my ($Event)       = @_;
+     my $clock_watcher = $Event->w;
      my $client;
-     if($ConnectionRetriesLeft > 0) {
+     UpdateStatus();
- 	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
- 		   ." Retries remaining: ".$ConnectionRetriesLeft);
-     } else {
- 	ShowStatus(GetServerHost()." >> DEAD <<");
-     }
      # Is it time to prune connection count:
- Line 294  sub Tick {
+ Line 370  sub Tick {
  	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
  	    my $Socket = $IdleConnections->pop();
  	    KillSocket($Socket);
+ 	    $IdleSeconds = 0;	# Otherwise all connections get trimmed to fast.
+ 	    UpdateStatus();
+ 	    if(($ConnectionCount == 0)) {
+ 		&child_exit(0);
+ 	    }
  	}
      } else {
  	$IdleSeconds = 0;	# Reset idle count if not idle.
- Line 312  sub Tick {
+ Line 394  sub Tick {
      # 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.
      #
+     #   Note this code is dead now...
+     #
      my $Requests = $WorkQueue->Count();
-     if (($ConnectionCount == 0)  && ($Requests > 0)) {
+     if (($ConnectionCount == 0)  && ($Requests > 0) && (!$LondConnecting)) {
  	if ($ConnectionRetriesLeft > 0) {
- 	    my $Connections = ($Requests <= $MaxConnectionCount) ?
+ 	    Debug(5,"Work but no connections, Make a new one");
- 		$Requests : $MaxConnectionCount;
+ 	    my $success;
- 	    Debug(5,"Work but no connections, start ".$Connections." of them");
+ 	    $success    = &MakeLondConnection;
- 	    my $successCount = 0;
+ 	    if($success == 0) { # All connections failed:
- 	    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.
+ 		CloseAllLondConnections(); # Should all be closed but....
  	    }
  	} else {
+ 	    $LondConnecting = 0;
  	    ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
  	    Debug(5,"Work in queue, but gave up on connections..flushing\n");
  	    EmptyQueue();	# Connections can't be established.
+ 	    CloseAllLondConnections(); # Should all already be closed but...
  	}
      }
+     if ($ConnectionCount == 0) {
+ 	$KeyMode = "";
+ 	$clock_watcher->cancel();
+     }
+     &UpdateStatus();
  }
  =pod
- Line 374  long enough, it will be shut down and re
+ Line 461  long enough, it will be shut down and re
  sub ServerToIdle {
      my $Socket   = shift;	# Get the socket.
+     $KeyMode = $Socket->{AuthenticationMode};
      delete($ActiveTransactions{$Socket}); # Server has no transaction
      &Debug(5, "Server to idle");
- Line 415  the data and Event->w->fd is the socket
+ Line 503  the data and Event->w->fd is the socket
  sub ClientWritable {
      my $Event    = shift;
      my $Watcher  = $Event->w;
+     if (!defined($Watcher)) {
+ 	&child_exit(-1,'No watcher for event in ClientWritable');
+     }
      my $Data     = $Watcher->data;
      my $Socket   = $Watcher->fd;
- Line 453  sub ClientWritable {
+ Line 544  sub ClientWritable {
  	    } else {		# Partial string sent.
  		$Watcher->data(substr($Data, $result));
  		if($result == 0) {    # client hung up on us!!
- 		    Log("INFO", "lonc pipe client hung up on us!");
+ 		    # Log("INFO", "lonc pipe client hung up on us!");
  		    $Watcher->cancel;
  		    $Socket->shutdown(2);
  		    $Socket->close();
- Line 478  sub ClientWritable {
+ Line 569  sub ClientWritable {
  	}
      } else {
  	$Watcher->cancel();	# A delayed request...just cancel.
+ 	return;
      }
  }
- Line 506  The transaction that is being completed.
+ Line 598  The transaction that is being completed.
  sub CompleteTransaction {
      &Debug(5,"Complete transaction");
-     my $Socket = shift;
-     my $Transaction = shift;
+     my ($Socket, $Transaction) = @_;
      if (!$Transaction->isDeferred()) { # Normal transaction
  	my $data   = $Socket->GetReply(); # Data to send.
- Line 517  sub CompleteTransaction {
+ Line 609  sub CompleteTransaction {
  	StartClientReply($Transaction, $data);
      } else {			# Delete deferred transaction file.
  	Log("SUCCESS", "A delayed transaction was completed");
- 	LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
+ 	LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest());
- 	unlink $Transaction->getFile();
+ 	unlink($Transaction->getFile());
      }
  }
  =pod
  =head1 StartClientReply
     Initiates a reply to a client where the reply data is a parameter.
- Line 537  sub CompleteTransaction {
+ Line 631  sub CompleteTransaction {
      The data to send to apached client.
  =cut
  sub StartClientReply {
-     my $Transaction   = shift;
-     my $data     = shift;
+     my ($Transaction, $data) = @_;
      my $Client   = $Transaction->getClient();
- Line 554  sub StartClientReply {
+ Line 648  sub StartClientReply {
  	      cb       => \&ClientWritable,
  	      data     => $data);
  }
  =pod
  =head2 FailTransaction
    Finishes a transaction with failure because the associated lond socket
- Line 564  sub StartClientReply {
+ Line 660  sub StartClientReply {
    - The transaction is 'live' in which case we initiate the sending
      of "con_lost" to the client.
- Deleting the transaction means killing it from the
+ Deleting the transaction means killing it from the %ActiveTransactions hash.
- %ActiveTransactions hash.
  Parameters:
- Line 573  Parameters:
+ Line 668  Parameters:
     The LondTransaction we are failing.
  =cut
  sub FailTransaction {
      my $transaction = shift;
-     Log("WARNING", "Failing transaction ".$transaction->getRequest());
-     Debug(1, "Failing transaction: ".$transaction->getRequest());
+     #  If the socket is dead, that's already logged.
+     if ($ConnectionRetriesLeft > 0) {
+ 	Log("WARNING", "Failing transaction "
+ 	    .$transaction->getLoggableRequest());
+     }
+     Debug(1, "Failing transaction: ".$transaction->getLoggableRequest());
      if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
  	my $client  = $transaction->getClient();
  	Debug(1," Replying con_lost to ".$transaction->getRequest());
  	StartClientReply($transaction, "con_lost\n");
      }
-     if($ConnectionRetriesLeft <= 0) {
- 	Log("CRITICAL", "Host marked dead: ".GetServerHost());
-     }
  }
  =pod
  =head1  EmptyQueue
    Fails all items in the work queue with con_lost.
    Note that each item in the work queue is a transaction.
  =cut
  sub EmptyQueue {
      $ConnectionRetriesLeft--;	# Counts as connection failure too.
      while($WorkQueue->Count()) {
- Line 612  sub EmptyQueue {
+ Line 713  sub EmptyQueue {
  Close all connections open on lond prior to exit e.g.
  =cut
  sub CloseAllLondConnections {
      foreach my $Socket (keys %ActiveConnections) {
- 	KillSocket($Socket);
+       if(exists($ActiveTransactions{$Socket})) {
+ 	FailTransaction($ActiveTransactions{$Socket});
+       }
+       KillSocket($Socket);
      }
  }
- =cut
  =pod
- Line 639  Parameters:
+ Line 743  Parameters:
  nonzero if we are allowed to create a new connection.
  =cut
  sub KillSocket {
      my $Socket = shift;
- Line 657  sub KillSocket {
+ Line 761  sub KillSocket {
  	delete ($ActiveTransactions{$Socket});
      }
      if(exists($ActiveConnections{$Socket})) {
+ 	$ActiveConnections{$Socket}->cancel;
  	delete($ActiveConnections{$Socket});
  	$ConnectionCount--;
  	if ($ConnectionCount < 0) { $ConnectionCount = 0; }
- Line 666  sub KillSocket {
+ Line 771  sub KillSocket {
      #
      if($ConnectionCount == 0) {
  	EmptyQueue();
+ 	CloseAllLondConnections; # Should all already be closed but...
      }
+     UpdateStatus();
  }
  =pod
- Line 763  sub LondReadable {
+ Line 870  sub LondReadable {
  	    "Lond connection lost.");
  	if(exists($ActiveTransactions{$Socket})) {
  	    FailTransaction($ActiveTransactions{$Socket});
+ 	} else {
+ 	    #  Socket is connecting and failed... need to mark
+ 	    #  no longer connecting.
+ 	    $LondConnecting = 0;
  	}
  	$Watcher->cancel();
  	KillSocket($Socket);
- Line 837  sub LondReadable {
+ Line 949  sub LondReadable {
  		.$RemoteHost." now ready for action");
  	}
  	ServerToIdle($Socket);	# Next work unit or idle.
+ 	#
+ 	$LondConnecting = 0;	# Best spot I can think of for this.
+ 	#
      } elsif ($State eq "SendingRequest") {
  	#  We need to be writable for this and probably don't belong
  	#  here inthe first place.
- 	Deubg(6, "SendingRequest state encountered in readable");
+ 	Debug(6, "SendingRequest state encountered in readable");
  	$Watcher->poll("w");
  	$Watcher->cb(\&LondWritable);
- Line 932  sub LondWritable {
+ Line 1048  sub LondWritable {
      SocketDump(6,$Socket);
-     if      ($State eq "Connected")         {
+     #  If the socket is writable, we must always write.
+     # Only by writing will we undergo state transitions.
- 	if ($Socket->Writable() != 0) {
+     # Old logic wrote in state specific code below, however
- 	    #  The write resulted in an error.
+     # That forces us at least through another invocation of
- 	    # We'll treat this as if the socket got disconnected:
+     # this function after writability is possible again.
- 	    Log("WARNING", "Connection to ".$RemoteHost.
+     # This logic also factors out common code for handling
- 		" has been disconnected");
+     # write failures... in all cases, write failures
+     # Kill the socket.
+     #  This logic makes the branches of the >big< if below
+     # so that the writing states are actually NO-OPs.
+     if ($Socket->Writable() != 0) {
+ 	#  The write resulted in an error.
+ 	# We'll treat this as if the socket got disconnected:
+ 	Log("WARNING", "Connection to ".$RemoteHost.
+ 	    " has been disconnected");
+ 	if(exists($ActiveTransactions{$Socket})) {
  	    FailTransaction($ActiveTransactions{$Socket});
- 	    $Watcher->cancel();
+ 	} else {
- 	    KillSocket($Socket);
+ 	    #  In the process of conneting, so need to turn that off.
- 	    return;
+ 	    $LondConnecting = 0;
  	}
+ 	$Watcher->cancel();
+ 	KillSocket($Socket);
+ 	return;
+     }
+     if      ($State eq "Connected")         {
  	#  "init" is being sent...
      } elsif ($State eq "Initialized")       {
  	# Now that init was sent, we switch
- Line 960  sub LondWritable {
+ Line 1095  sub LondWritable {
  	# are echoing it back. This is a no-op,
  	# we're waiting for the state to change
- 	if($Socket->Writable() != 0) {
- 	    $Watcher->cancel();
- 	    KillSocket($Socket);
- 	    return;
- 	}
      } elsif ($State eq "ChallengeReplied")  {
  	# The echo was sent back, so we switch
  	# to watching readability.
- Line 975  sub LondWritable {
+ Line 1103  sub LondWritable {
  	$Watcher->poll("r");
      } elsif ($State eq "RequestingVersion") {
  	# Sending the peer a version request...
- 	if($Socket->Writable() != 0) {
- 	    $Watcher->cancel();
- 	    KillSocket($Socket);
- 	    return;
- 	}
      } elsif ($State eq "ReadingVersionString") {
  	# Transition to read since we have sent the
  	# version command and now just need to read the
- Line 991  sub LondWritable {
+ Line 1114  sub LondWritable {
      } elsif ($State eq "SetHost") {
  	#  Setting the remote domain...
- 	if($Socket->Writable() != 0) {
- 	    $Watcher->cancel();
- 	    KillSocket($Socket);
- 	    return;
- 	}
      } elsif ($State eq "HostSet") {
  	# Back to readable to get the ok.
- Line 1007  sub LondWritable {
+ Line 1125  sub LondWritable {
      } elsif ($State eq "RequestingKey")     {
  	# At this time we're requesting the key.
  	# again, this is essentially a no-op.
- 	# we'll write the next chunk until the
- 	# state changes.
- 	if($Socket->Writable() != 0) {
- 	    # Write resulted in an error.
- 	    $Watcher->cancel();
- 	    KillSocket($Socket);
- 	    return;
- 	}
      } elsif ($State eq "ReceivingKey")      {
  	# Now we need to wait for the key
  	# to come back from the peer:
- Line 1030  sub LondWritable {
+ Line 1138  sub LondWritable {
  	# At this time we are sending a request to the
  	# peer... write the next chunk:
- 	if($Socket->Writable() != 0) {
- 	    if(exists($ActiveTransactions{$Socket})) {
- 		Debug(3, "Lond connection lost, failing transactions");
- 		FailTransaction($ActiveTransactions{$Socket});
- 	    }
- 	    $Watcher->cancel();
- 	    KillSocket($Socket);
- 	    return;
- 	}
      } elsif ($State eq "ReceivingReply")    {
  	# The send has completed.  Wait for the
- Line 1059  sub LondWritable {
+ Line 1156  sub LondWritable {
      }
  }
  =pod
  =cut
  sub QueueDelayed {
      Debug(3,"QueueDelayed called");
- Line 1069  sub QueueDelayed {
+ Line 1169  sub QueueDelayed {
      Debug(4, "Delayed path: ".$path);
      opendir(DIRHANDLE, $path);
-     my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
+     my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@all_host_ids)).')';
+     my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE));
      closedir(DIRHANDLE);
-     my $dfname;
+     foreach my $dfname (sort(@alldelayed)) {
-     my $reqfile;
+ 	my $reqfile = "$path/$dfname";
-     foreach $dfname (sort  @alldelayed) {
+ 	my ($host_id) = ($dfname =~ /\.([^.]*)$/);
- 	$reqfile = "$path/$dfname";
+ 	Debug(4, "queueing ".$reqfile." for $host_id");
- 	Debug(4, "queueing ".$reqfile);
  	my $Handle = IO::File->new($reqfile);
  	my $cmd    = <$Handle>;
  	chomp $cmd;		# There may or may not be a newline...
  	$cmd = $cmd."\n";	# now for sure there's exactly one newline.
- 	my $Transaction = LondTransaction->new($cmd);
+ 	my $Transaction = LondTransaction->new("sethost:$host_id:$cmd");
  	$Transaction->SetDeferred($reqfile);
  	QueueTransaction($Transaction);
      }
- Line 1105  sub MakeLondConnection {
+ Line 1205  sub MakeLondConnection {
  	  .GetServerPort());
      my $Connection = LondConnection->new(&GetServerHost(),
- 					 &GetServerPort());
+ 					 &GetServerPort(),
+ 					 &GetHostId());
-     if($Connection eq undef) {	# Needs to be more robust later.
+     if($Connection eq undef) {
  	Log("CRITICAL","Failed to make a connection with lond.");
  	$ConnectionRetriesLeft--;
  	return 0;		# Failure.
      }  else {
+ 	$LondConnecting = 1;	# Connection in progress.
  	# The connection needs to have writability
  	# monitored in order to send the init sequence
  	# that starts the whole authentication/key
- Line 1120  sub MakeLondConnection {
+ Line 1222  sub MakeLondConnection {
  	#
  	my $Socket = $Connection->GetSocket();
  	if($Socket eq undef) {
- 	    die "did not get a socket from the connection";
+ 	    &child_exit(-1, "did not get a socket from the connection");
  	} else {
  	    &Debug(9,"MakeLondConnection got socket: ".$Socket);
  	}
- Line 1133  sub MakeLondConnection {
+ Line 1235  sub MakeLondConnection {
  			   data     => $Connection,
  			   desc => 'Connection to lond server');
  	$ActiveConnections{$Connection} = $event;
+ 	if ($ConnectionCount == 0) {
+ 	    &SetupTimer;	# Need to handle timeouts with connections...
+ 	}
  	$ConnectionCount++;
  	Debug(4, "Connection count = ".$ConnectionCount);
  	if($ConnectionCount == 1) { # First Connection:
- Line 1172  The text of the request to send.
+ Line 1276  The text of the request to send.
  =cut
  sub StartRequest {
-     my $Lond     = shift;
-     my $Request  = shift;	# This is a LondTransaction.
+     my ($Lond, $Request) = @_;
      Debug(6, "StartRequest: ".$Request->getRequest());
- Line 1224  sub QueueTransaction {
+ Line 1328  sub QueueTransaction {
      if(!defined $LondSocket) {	# Need to queue request.
  	Debug(5,"Must queue...");
  	$WorkQueue->enqueue($requestData);
- 	if($ConnectionCount < $MaxConnectionCount) {
+ 	Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting");
+ 	if(($ConnectionCount < $MaxConnectionCount)   && (! $LondConnecting)) {
  	    if($ConnectionRetriesLeft > 0) {
  		Debug(5,"Starting additional lond connection");
- 		if(MakeLondConnection() == 0) {
+ 		if(&MakeLondConnection() == 0) {
  		    EmptyQueue();	# Fail transactions, can't make connection.
+ 		    CloseAllLondConnections; # Should all be closed but...
  		}
  	    } else {
  		ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
+ 		$LondConnecting = 0;
  		EmptyQueue();	# It's worse than that ... he's dead Jim.
+ 		CloseAllLondConnections; # Should all be closed but..
  	    }
  	}
      } else {			# Can start the request:
- Line 1275  sub ClientRequest {
+ Line 1384  sub ClientRequest {
      Debug(8,"Data: ".$data." this read: ".$thisread);
      $data = $data.$thisread;	# Append new data.
      $watcher->data($data);
-     if($data =~ /(.*\n)/) {	# Request entirely read.
+     if($data =~ /\n$/) {	# Request entirely read.
- 	if($data eq "close_connection_exit\n") {
+ 	if ($data eq "close_connection_exit\n") {
  	    Log("CRITICAL",
  		"Request Close Connection ... exiting");
  	    CloseAllLondConnections();
  	    exit;
+ 	} elsif ($data eq "reset_retries\n") {
+ 	    Log("INFO", "Resetting Connection Retries.");
+ 	    $ConnectionRetriesLeft = $ConnectionRetries;
+ 	    &UpdateStatus();
+ 	    my $Transaction = LondTransaction->new($data);
+ 	    $Transaction->SetClient($socket);
+ 	    StartClientReply($Transaction, "ok\n");
+ 	    $watcher->cancel();
+ 	    return;
  	}
  	Debug(8, "Complete transaction received: ".$data);
- 	if($LogTransactions) {
+ 	if ($LogTransactions) {
  	    Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
  	}
  	my $Transaction = LondTransaction->new($data);
- Line 1294  sub ClientRequest {
+ Line 1412  sub ClientRequest {
  }
+ #
+ #     Accept a connection request for a client (lonc child) and
+ #    start up an event watcher to keep an eye on input from that
+ #    Event.  This can be called both from NewClient and from
+ #    ChildProcess.
+ # Parameters:
+ #    $socket       - The listener socket.
+ # Returns:
+ #   NONE
+ # Side Effects:
+ #    An event is made to watch the accepted connection.
+ #    Active clients hash is updated to reflect the new connection.
+ #    The client connection count is incremented.
+ #
+ sub accept_client {
+     my ($socket) = @_;
+     Debug(8, "Entering accept for lonc UNIX socket\n");
+     my $connection = $socket->accept();	# Accept the client connection.
+     Debug(8,"Connection request accepted from "
+ 	  .GetPeername($connection, AF_UNIX));
+     my $description = sprintf("Connection to lonc client %d",
+ 			      $ClientConnection);
+     Debug(9, "Creating event named: ".$description);
+     Event->io(cb      => \&ClientRequest,
+ 	      poll    => 'r',
+ 	      desc    => $description,
+ 	      data    => "",
+ 	      fd      => $connection);
+     $ActiveClients{$connection} = $ClientConnection;
+     $ClientConnection++;
+ }
  =pod
- Line 1312  sub NewClient {
+ Line 1464  sub NewClient {
      my $event      = shift;		# Get the event parameters.
      my $watcher    = $event->w;
      my $socket     = $watcher->fd;	# Get the event' socket.
-     my $connection = $socket->accept();	# Accept the client connection.
-     Debug(8,"Connection request accepted from "
- 	  .GetPeername($connection, AF_UNIX));
-     my $description = sprintf("Connection to lonc client %d",
+     &accept_client($socket);
- 			      $ClientConnection);
-     Debug(9, "Creating event named: ".$description);
-     Event->io(cb      => \&ClientRequest,
- 	      poll    => 'r',
- 	      desc    => $description,
- 	      data    => "",
- 	      fd      => $connection);
-     $ActiveClients{$connection} = $ClientConnection;
-     $ClientConnection++;
  }
  =pod
- Line 1336  sub NewClient {
+ Line 1475  sub NewClient {
  Returns the name of the UNIX socket on which to listen for client
  connections.
+ =head2 Parameters:
+     host (optional)  - Name of the host socket to return.. defaults to
+                        the return from GetServerHost().
  =cut
  sub GetLoncSocketPath {
-     return $UnixSocketDir."/".GetServerHost();
+     my $host = GetServerHost();	# Default host.
+     if (@_) {
+ 	($host)  = @_;		# Override if supplied.
+     }
+     return $UnixSocketDir."/".$host;
  }
  =pod
- Line 1356  sub GetServerHost {
+ Line 1505  sub GetServerHost {
  =pod
+ =head2 GetServerId
+ Returns the hostid whose lond we talk with.
+ =cut
+ sub GetHostId {
+     return $RemoteHostId;		# Setup by the fork.
+ }
+ =pod
  =head2 GetServerPort
  Returns the lond port number.
- Line 1376  connection.  The event handler establish
+ Line 1537  connection.  The event handler establish
  (creating a communcations channel), that int turn will establish
  another event handler to subess requests.
+ =head2  Parameters:
+    host (optional)   Name of the host to set up a unix socket to.
  =cut
  sub SetupLoncListener {
+     my ($host,$SocketName) = @_;
+     if (!$host) { $host = &GetServerHost(); }
+     if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); }
-     my $socket;
-     my $SocketName = GetLoncSocketPath();
      unlink($SocketName);
+     my $socket;
      unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
- 					    Listen => 10,
+ 					    Listen => 250,
  					    Type   => SOCK_STREAM)) {
- 	die "Failed to create a lonc listner socket";
+ 	if($I_am_child) {
+ 	    &child_exit(-1, "Failed to create a lonc listener socket");
+ 	} else {
+ 	    die "Failed to create a lonc listner socket";
+ 	}
      }
-     Event->io(cb     => \&NewClient,
+     return $socket;
- 	      poll   => 'r',
- 	      desc   => 'Lonc listener Unix Socket',
- 	      fd     => $socket);
  }
  #
- Line 1421  into the status file.
+ Line 1591  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
  sub ChildStatus {
      my $event = shift;
      my $watcher = $event->w;
      Debug(2, "Reporting child status because : ".$watcher->data);
      my $docdir = $perlvar{'lonDocRoot'};
-     my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
-     print $fh $$."\t".$RemoteHost."\t".$Status."\t".
+     open(LOG,">>$docdir/lon-status/loncstatus.txt");
+     flock(LOG,LOCK_EX);
+     print LOG $$."\t".$RemoteHost."\t".$Status."\t".
  	$RecentLogEntry."\n";
      #
      #  Write out information about each of the connections:
      #
-     print $fh "Active connection statuses: \n";
+     if ($DebugLevel > 2) {
-     my $i = 1;
+ 	print LOG "Active connection statuses: \n";
-     print STDERR  "================================= Socket Status Dump:\n";
+ 	my $i = 1;
-     foreach my $item (keys %ActiveConnections) {
+ 	print STDERR  "================================= Socket Status Dump:\n";
- 	my $Socket = $ActiveConnections{$item}->data;
+ 	foreach my $item (keys %ActiveConnections) {
- 	my $state  = $Socket->GetState();
+ 	    my $Socket = $ActiveConnections{$item}->data;
- 	print $fh "Connection $i State: $state\n";
+ 	    my $state  = $Socket->GetState();
- 	print STDERR "---------------------- Connection $i \n";
+ 	    print LOG "Connection $i State: $state\n";
- 	$Socket->Dump();
+ 	    print STDERR "---------------------- Connection $i \n";
- 	$i++;
+ 	    $Socket->Dump(-1);	# Ensure it gets dumped..
+ 	    $i++;
+ 	}
      }
+     flock(LOG,LOCK_UN);
+     close(LOG);
      $ConnectionRetriesLeft = $ConnectionRetries;
+     UpdateStatus();
  }
  =pod
- Line 1466  sub SignalledToDeath {
+ Line 1645  sub SignalledToDeath {
      chomp($signal);
      Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "
  	."died through "."\"$signal\"");
-     LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
+     #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
- 	    ."\"$signal\"");
+ #	    ."\"$signal\"");
      exit 0;
  }
+ =pod
  =head2 ToggleDebug
  This sub toggles trace debugging on and off.
- Line 1487  sub ToggleDebug {
+ Line 1668  sub ToggleDebug {
  }
+ =pod
  =head2 ChildProcess
  This sub implements a child process for a single lonc daemon.
+ Optional parameter:
+    $socket  - if provided, this is a socket already open for listen
+               on the client socket. Otherwise, a new listen is set up.
  =cut
  sub ChildProcess {
+     #  We've inherited all the
+     #  events of our parent and those have to be cancelled or else
+     #  all holy bloody chaos will result.. trust me, I already made
+     #  >that< mistake.
+     my $host = GetServerHost();
+     foreach my $listener (keys %parent_dispatchers) {
+ 	my $watcher = $parent_dispatchers{$listener};
+ 	my $s       = $watcher->fd;
+ 	if ($listener ne $host) { # Close everyone but me.
+ 	    Debug(5, "Closing listen socket for $listener");
+ 	    $s->close();
+ 	}
+ 	Debug(5, "Killing watcher for $listener");
+ 	$watcher->cancel();
+ 	delete($parent_dispatchers{$listener});
+     }
+     #  kill off the parent's signal handlers too!
+     #
+     for my $handler (keys %parent_handlers) {
+ 	my $watcher = $parent_handlers{$handler};
+ 	$watcher->cancel();
+ 	delete($parent_handlers{$handler});
+     }
+     $I_am_child    = 1;		# Seems like in spite of it all I may still getting
+                                 # parent event dispatches.. flag I'm a child.
      #
      #  Signals must be handled by the Event framework...
- #
+     #
      Event->signal(signal   => "QUIT",
  		  cb       => \&SignalledToDeath,
- Line 1515  sub ChildProcess {
+ Line 1732  sub ChildProcess {
  		  cb       => \&ToggleDebug,
  		  data     => "INT");
-     SetupTimer();
+     #  Figure out if we got passed a socket or need to open one to listen for
+     #  client requests.
-     SetupLoncListener();
+     my ($socket) = @_;
+     if (!$socket) {
+ 	$socket =  SetupLoncListener();
+     }
+     #  Establish an event to listen for client connection requests.
+     Event->io(cb   => \&NewClient,
+ 	      poll => 'r',
+ 	      desc => 'Lonc Listener Unix Socket',
+ 	      fd   => $socket);
-     $Event::Debuglevel = $DebugLevel;
+     $Event::DebugLevel = $DebugLevel;
      Debug(9, "Making initial lond connection for ".$RemoteHost);
  # Setup the initial server connection:
-      # &MakeLondConnection(); // let first work requirest do it.
+      # &MakeLondConnection(); // let first work request do it.
+     #  need to accept the connection since the event may  not fire.
+     &accept_client($socket);
      Debug(9,"Entering event loop");
      my $ret = Event::loop();		#  Start the main event loop.
-     die "Main event loop exited!!!";
+     &child_exit (-1,"Main event loop exited!!!");
  }
  #  Create a new child for host passed in:
  sub CreateChild {
+     my ($host, $hostid) = @_;
      my $sigset = POSIX::SigSet->new(SIGINT);
      sigprocmask(SIG_BLOCK, $sigset);
-     my $host = shift;
      $RemoteHost = $host;
      Log("CRITICAL", "Forking server for ".$host);
      my $pid          = fork;
      if($pid) {			# Parent
  	$RemoteHost = "Parent";
- 	$ChildHash{$pid} = $host;
+ 	$ChildPid{$pid} = $host;
- 	$HostToPid{$host}= $pid;
  	sigprocmask(SIG_UNBLOCK, $sigset);
+ 	undef(@all_host_ids);
      } else {			# child.
+ 	$RemoteHostId = $hostid;
  	ShowStatus("Connected to ".$RemoteHost);
  	$SIG{INT} = 'DEFAULT';
  	sigprocmask(SIG_UNBLOCK, $sigset);
- 	ChildProcess;		# Does not return.
+ 	&ChildProcess();		# Does not return.
      }
+ }
+ # parent_client_connection:
+ #    Event handler that processes client connections for the parent process.
+ #    This sub is called when the parent is listening on a socket and
+ #    a connection request arrives.  We must:
+ #     Start a child process to accept the connection request.
+ #     Kill our listen on the socket.
+ # Parameter:
+ #    event       - The event object that was created to monitor this socket.
+ #                  event->w->fd is the socket.
+ # Returns:
+ #    NONE
+ #
+ sub parent_client_connection {
+     if ($I_am_child) {
+ 	#  Should not get here, but seem to anyway:
+ 	&Debug(5," Child caught parent client connection event!!");
+ 	my ($event) = @_;
+ 	my $watcher = $event->w;
+ 	$watcher->cancel();	# Try to kill it off again!!
+     } else {
+ 	&Debug(9, "parent_client_connection");
+ 	my ($event)   = @_;
+ 	my $watcher   = $event->w;
+ 	my $socket    = $watcher->fd;
+ 	my $connection = $socket->accept();	# Accept the client connection.
+ 	Event->io(cb      => \&get_remote_hostname,
+ 		  poll    => 'r',
+ 		  data    => "",
+ 		  fd      => $connection);
+     }
  }
+ sub get_remote_hostname {
+     my ($event)   = @_;
+     my $watcher   = $event->w;
+     my $socket    = $watcher->fd;
+     my $thisread;
+     my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
+     Debug(8, "rcv:  data length = ".length($thisread)." read =".$thisread);
+     if (!defined($rv) || length($thisread) == 0) {
+ 	# Likely eof on socket.
+ 	Debug(5,"Client Socket closed on lonc for p_c_c");
+ 	close($socket);
+ 	$watcher->cancel();
+ 	return;
+     }
+     my $data    = $watcher->data().$thisread;
+     $watcher->data($data);
+     if($data =~ /\n$/) {	# Request entirely read.
+ 	chomp($data);
+     } else {
+ 	return;
+     }
+     &Debug(5,"Creating child for $data (parent_client_connection)");
+     (my $hostname,my $lonid,@all_host_ids) = split(':',$data);
+     $ChildHost{$hostname}++;
+     if ($ChildHost{$hostname} == 1) {
+ 	&CreateChild($hostname,$lonid);
+     } else {
+ 	&Log('WARNING',"Request for a second child on $hostname");
+     }
+     # Clean up the listen since now the child takes over until it exits.
+     $watcher->cancel();		# Nolonger listening to this event
+     $socket->send("done\n");
+     $socket->close();
+ }
+ # parent_listen:
+ #    Opens a socket and starts a listen for the parent process on a client UNIX
+ #    domain socket.
+ #
+ #    This involves:
+ #       Creating a socket for listen.
+ #       Removing any socket lock file
+ #       Adding an event handler for this socket becoming readable
+ #         To the parent's event dispatcher.
+ # Parameters:
+ #    loncapa_host    - LonCAPA cluster name of the host represented by the client
+ #                      socket.
+ # Returns:
+ #    NONE
+ #
+ sub parent_listen {
+     my ($loncapa_host) = @_;
+     Debug(5, "parent_listen: $loncapa_host");
+     my ($socket,$file);
+     if (!$loncapa_host) {
+ 	$loncapa_host = 'common_parent';
+ 	$file         = $perlvar{'lonSockCreate'};
+     } else {
+ 	$file         = &GetLoncSocketPath($loncapa_host);
+     }
+     $socket = &SetupLoncListener($loncapa_host,$file);
+     $listening_to{$socket} = $loncapa_host;
+     if (!$socket) {
+ 	die "Unable to create a listen socket for $loncapa_host";
+     }
+     my $lock_file = $file.".lock";
+     unlink($lock_file);		# No problem if it doesn't exist yet [startup e.g.]
+     my $watcher =
+ 	Event->io(cb    => \&parent_client_connection,
+ 		  poll  => 'r',
+ 		  desc  => "Parent listener unix socket ($loncapa_host)",
+ 		  data => "",
+ 		  fd    => $socket);
+     $parent_dispatchers{$loncapa_host} = $watcher;
+ }
+ sub parent_clean_up {
+     my ($loncapa_host) = @_;
+     Debug(1, "parent_clean_up: $loncapa_host");
+     my $socket_file = &GetLoncSocketPath($loncapa_host);
+     unlink($socket_file);	# No problem if it doesn't exist yet [startup e.g.]
+     my $lock_file   = $socket_file.".lock";
+     unlink($lock_file);		# No problem if it doesn't exist yet [startup e.g.]
+ }
+ #    This sub initiates a listen on the common unix domain lonc client socket.
+ #    loncnew starts up with no children, and only spawns off children when a
+ #    connection request occurs on the common client unix socket.  The spawned
+ #    child continues to run until it has been idle a while at which point it
+ #    eventually exits and once more the parent picks up the listen.
+ #
+ #  Parameters:
+ #      NONE
+ #  Implicit Inputs:
+ #    The configuration file that has been read in by LondConnection.
+ #  Returns:
+ #     NONE
+ #
+ sub listen_on_common_socket {
+     Debug(5, "listen_on_common_socket");
+     &parent_listen();
+ }
+ #   server_died is called whenever a child process exits.
+ #   Since this is dispatched via a signal, we must process all
+ #   dead children until there are no more left.  The action
+ #   is to:
+ #      - Remove the child from the bookeeping hashes
+ #      - Re-establish a listen on the unix domain socket associated
+ #        with that host.
+ # Parameters:
+ #    The event, but we don't actually care about it.
+ sub server_died {
+     &Debug(9, "server_died called...");
+     while(1) {			# Loop until waitpid nowait fails.
+ 	my $pid = waitpid(-1, WNOHANG);
+ 	if($pid <= 0) {
+ 	    return;		# Nothing left to wait for.
+ 	}
+ 	# need the host to restart:
+ 	my $host = $ChildPid{$pid};
+ 	if($host) {		# It's for real...
+ 	    &Debug(9, "Caught sigchild for $host");
+ 	    delete($ChildPid{$pid});
+ 	    delete($ChildHost{$host});
+ 	    &parent_clean_up($host);
+ 	} else {
+ 	    &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
+ 	}
+     }
+ }
  #
  #  Parent process logic pass 1:
  #   For each entry in the hosts table, we will
- Line 1606  ShowStatus("Forking node servers");
+ Line 2018  ShowStatus("Forking node servers");
  Log("CRITICAL", "--------------- Starting children ---------------");
  LondConnection::ReadConfig;               # Read standard config files.
- my $HostIterator = LondConnection::GetHostIterator;
- while (! $HostIterator->end()) {
-     my $hostentryref = $HostIterator->get();
+ $RemoteHost = "[parent]";
-     CreateChild($hostentryref->[0]);
+ &listen_on_common_socket();
-     $HostHash{$hostentryref->[0]} = $hostentryref->[4];
-     $HostIterator->next();
- }
  $RemoteHost = "Parent Server";
  # Maintain the population:
  ShowStatus("Parent keeping the flock");
- #
- #   Set up parent signals:
- #
- $SIG{INT}  = \&Terminate;
- $SIG{TERM} = \&Terminate;
- $SIG{HUP}  = \&Restart;
- $SIG{USR1} = \&CheckKids;
- $SIG{USR2} = \&UpdateKids;	# LonManage update request.
- while(1) {
-     my $deadchild = wait();
-     if(exists $ChildHash{$deadchild}) {	# need to restart.
- 	my $deadhost = $ChildHash{$deadchild};
- 	delete($HostToPid{$deadhost});
- 	delete($ChildHash{$deadchild});
- 	Log("WARNING","Lost child pid= ".$deadchild.
- 	      "Connected to host ".$deadhost);
- 	Log("INFO", "Restarting child procesing ".$deadhost);
- 	CreateChild($deadhost);
-     }
- }
+ # We need to setup a SIGChild event to handle the exit (natural or otherwise)
+ # of the children.
+ Event->signal(cb       => \&server_died,
+ 	      desc     => "Child exit handler",
+ 	      signal   => "CHLD");
+ # Set up all the other signals we set up.
+ $parent_handlers{INT} = Event->signal(cb       => \&Terminate,
+ 				      desc     => "Parent INT handler",
+ 				      signal   => "INT");
+ $parent_handlers{TERM} = Event->signal(cb       => \&Terminate,
+ 				       desc     => "Parent TERM handler",
+ 				       signal   => "TERM");
+ $parent_handlers{HUP}  = Event->signal(cb       => \&KillThemAll,
+ 				       desc     => "Parent HUP handler.",
+ 				       signal   => "HUP");
+ $parent_handlers{USR1} = Event->signal(cb       => \&CheckKids,
+ 				       desc     => "Parent USR1 handler",
+ 				       signal   => "USR1");
+ $parent_handlers{USR2} = Event->signal(cb       => \&UpdateKids,
+ 				       desc     => "Parent USR2 handler.",
+ 				       signal   => "USR2");
+ #  Start procdesing events.
+ $Event::DebugLevel = $DebugLevel;
+ Debug(9, "Parent entering event loop");
+ my $ret = Event::loop();
+ die "Main Event loop exited: $ret";
  =pod
- Line 1664  sub CheckKids {
+ Line 2081  sub CheckKids {
      my $now=time;
      my $local=localtime($now);
      print $fh "LONC status $local - parent $$ \n\n";
-     foreach my $pid (keys %ChildHash) {
+     foreach my $host (keys %parent_dispatchers) {
+ 	print $fh "LONC Parent process listening for $host\n";
+     }
+     foreach my $pid (keys %ChildPid) {
  	Debug(2, "Sending USR1 -> $pid");
  	kill 'USR1' => $pid;	# Tell Child to report status.
- 	sleep 1;		# Wait so file doesn't intermix.
      }
  }
  =pod
- Line 1701  sub UpdateKids {
+ Line 2121  sub UpdateKids {
      Log("INFO", "Updating connections via SIGUSR2");
-     #  Just in case we need to kill our own lonc, we wait a few seconds to
+     #  I'm not sure what I was thinking in the first implementation.
-     #  give it a chance to receive and relay lond's response to the
+     # someone will have to work hard to convince me the effect is any
-     #  re-init command.
+     # different than Restart, especially now that we don't start up
-     #
+     # per host servers automatically, may as well just restart.
+     # The down side is transactions that are in flight will get timed out
-     sleep(2);			# Wait a couple of seconds.
+     # (lost unless they are critical).
-     my %hosts;                   # Indexed by loncapa hostname, value=ip.
+     &KillThemAll();
-     # 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.
- 	}
-     }
  }
- Line 1794  sub Restart {
+ Line 2147  sub Restart {
      Log("CRITICAL", "Restarting");
      my $execdir = $perlvar{'lonDaemons'};
      unlink("$execdir/logs/lonc.pid");
-     exec("$execdir/loncnew");
+     exec("$executable");
  }
  =pod
- Line 1808  SIGHUP.  Responds to sigint and sigterm.
+ Line 2161  SIGHUP.  Responds to sigint and sigterm.
  sub KillThemAll {
      Debug(2, "Kill them all!!");
-     local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
-     foreach my $pid (keys %ChildHash) {
+     #local($SIG{CHLD}) = 'IGNORE';
- 	my $serving = $ChildHash{$pid};
+     # Our children >will< die.
- 	Debug(2, "Killing lonc for $serving pid = $pid");
+     # but we need to catch their death and cleanup after them in case this is
- 	ShowStatus("Killing lonc for $serving pid = $pid");
+     # a restart set of kills
- 	Log("CRITICAL", "Killing lonc for $serving pid = $pid");
+     my @allpids = keys(%ChildPid);
+     foreach my $pid (@allpids) {
+ 	my $serving = $ChildPid{$pid};
+ 	ShowStatus("Nicely Killing lonc for $serving pid = $pid");
+ 	Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
  	kill 'QUIT' => $pid;
- 	delete($ChildHash{$pid});
      }
-     my $execdir = $perlvar{'lonDaemons'};
+     ShowStatus("Finished killing child processes off.");
-     unlink("$execdir/logs/lonc.pid");
+ }
+ #
+ #  Kill all children via KILL.  Just in case the
+ #  first shot didn't get them.
+ sub really_kill_them_all_dammit
+ {
+     Debug(2, "Kill them all Dammit");
+     local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them.
+     foreach my $pid (keys %ChildPid) {
+ 	my $serving = $ChildPid{$pid};
+ 	&ShowStatus("Nastily killing lonc for $serving pid = $pid");
+ 	Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
+ 	kill 'KILL' => $pid;
+ 	delete($ChildPid{$pid});
+ 	my $execdir = $perlvar{'lonDaemons'};
+ 	unlink("$execdir/logs/lonc.pid");
+     }
  }
  =pod
- Line 1831  Terminate the system.
+ Line 2205  Terminate the system.
  =cut
  sub Terminate {
-     KillThemAll;
+     &Log("CRITICAL", "Asked to kill children.. first be nice...");
+     &KillThemAll;
+     #
+     #  By now they really should all be dead.. but just in case
+     #  send them all SIGKILL's after a bit of waiting:
+     sleep(4);
+     &Log("CRITICAL", "Now kill children nasty");
+     &really_kill_them_all_dammit;
      Log("CRITICAL","Master process exiting");
      exit 0;
  }
+ sub my_hostname {
+     use Sys::Hostname;
+     my $name = &hostname();
+     &Debug(9,"Name is $name");
+     return $name;
+ }
  =pod
  =head1 Theory
- Line 1877  A hash of lond connections that have no
+ Line 2267  A hash of lond connections that have no
  can be closed if they are idle for a long enough time.
  =cut
+ =pod
+ =head1 Log messages
+ The following is a list of log messages that can appear in the
+ lonc.log file.  Each log file has a severity and a message.
+ =over 2
+ =item Warning  A socket timeout was detected
+ If there are pending transactions in the socket's queue,
+ they are failed (saved if critical).  If the connection
+ retry count gets exceeded by this, the
+ remote host is marked as dead.
+ Called when timeouts occured during the connection and
+ connection dialog with a remote host.
+ =item Critical Host makred DEAD <hostname>
+ The numer of retry counts for contacting a host was
+ exceeded. The host is marked dead an no
+ further attempts will be made by that child.
+ =item Info lonc pipe client hung up on us
+ Write to the client pipe indicated no data transferred
+ Socket to remote host is shut down.  Reply to the client
+ is discarded.  Note: This is commented out in &ClientWriteable
+ =item Success  Reply from lond: <data>
+ Can be enabled for debugging by setting LogTransactions to nonzero.
+ Indicates a successful transaction with lond, <data> is the data received
+ from the remote lond.
+ =item Success A delayed transaction was completed
+ A transaction that must be reliable was executed and completed
+ as lonc restarted.  This is followed by a mesage of the form
+   S: client-name : request
+ =item WARNING  Failing transaction <cmd>:<subcmd>
+ Transaction failed on a socket, but the failure retry count for the remote
+ node has not yet been exhausted (the node is not yet marked dead).
+ cmd is the command, subcmd is the subcommand.  This results from a con_lost
+ when communicating with lond.
+ =item WARNING Shutting down a socket
+ Called when a socket is being closed to lond.  This is emitted both when
+ idle pruning is being done and when the socket has been disconnected by the remote.
+ =item WARNING Lond connection lost.
+ Called when a read from lond's socket failed indicating lond has closed the
+ connection or died.  This should be followed by one or more
+  "WARNING Failing transaction..." msgs for each in-flight or queued transaction.
+ =item INFO Connected to lond version:  <version>
+ When connection negotiation is complete, the lond version is requested and logged here.
+ =item SUCCESS Connection n to host now ready for action
+ Emitted when connection has been completed with lond. n is then number of
+ concurrent connections and host, the host to which the connection has just
+ been established.
+ =item WARNING Connection to host has been disconnected
+ Write to a lond resulted in failure status.  Connection to lond is dropped.
+ =item SUCCESS Created connection n to host host
+ Initial connection request to host..(before negotiation).
+ =item CRITICAL Request Close Connection ... exiting
+ Client has sent "close_connection_exit"   The loncnew server is exiting.
+ =item INFO Resetting Connection Retries
+ Client has sent "reset_retries" The lond connection retries are reset to zero for the
+ corresponding lond.
+ =item SUCCESS Transaction <data>
+ Only emitted if the global variable $LogTransactions was set to true.
+ A client has requested a lond transaction <data> is the contents of the request.
+ =item SUCCESS Toggled transaction logging <LogTransactions>
+ The state of the $LogTransactions global has been toggled, and its current value
+ (after being toggled) is displayed.  When non zero additional logging of transactions
+ is enabled for debugging purposes.  Transaction logging is toggled on receipt of a USR2
+ signal.
+ =item CRITICAL Abnormal exit. Child <pid> for <host> died thorugh signal.
+ QUIT signal received.  lonc child process is exiting.
+ =item SUCCESS New debugging level for <RemoteHost> now <DebugLevel>
+ Debugging toggled for the host loncnew is talking with.
+ Currently debugging is a level based scheme with higher number
+ conveying more information.  The daemon starts out at
+ DebugLevel 0 and can toggle back and forth between that and
+ DebugLevel 2  These are controlled by
+ the global variables $DebugLevel and $NextDebugLevel
+ The debug level can go up to 9.
+ SIGINT toggles the debug level.  The higher the debug level the
+ more debugging information is spewed.  See the Debug
+ sub in loncnew.
+ =item CRITICAL Forking server for host
+ A child is being created to service requests for the specified host.
+ =item WARNING Request for a second child on hostname
+ Somehow loncnew was asked to start a second child on a host that already had a child
+ servicing it.  This request is not honored, but themessage is emitted.  This could happen
+ due to a race condition.  When a client attempts to contact loncnew for a new host, a child
+ is forked off to handle the requests for that server.  The parent then backs off the Unix
+ domain socket leaving it for the child to service all requests.  If in the time between
+ creating the child, and backing off, a new connection request comes in to the unix domain
+ socket, this could trigger (unlikely but remotely possible),.
+ =item CRITICAL ------ Starting Children ----
+ This message should probably be changed to "Entering event loop"  as the loncnew only starts
+ children as needed.  This message is emitted as new events are established and
+ the event processing loop is entered.
+ =item INFO Updating connections via SIGUSR2
+ SIGUSR2 received. The original code would kill all clients, re-read the host file,
+ then restart children for each host.  Now that childrean aree started on demand, this
+ just kills all child processes and lets requests start them as needed again.
+ =item CRITICAL Restarting
+ SigHUP received.  all the children are killed and the script exec's itself to start again.
+ =item CRITICAL Nicely killing lonc for host pid = <pid>
+ Attempting to kill the child that is serving the specified host (pid given) cleanly via
+ SIGQUIT  The child should handle that, clean up nicely and exit.
+ =item CRITICAL Nastily killing lonc for host pid = <pid>
+ The child specified did not die when requested via SIGQUIT.  Therefore it is killed
+ via SIGKILL.
+ =item CRITICAL Asked to kill children.. first be nice..
+ In the parent's INT handler.  INT kills the child processes.  This inidicate loncnew
+ is about to attempt to kill all known children via SIGQUIT.  This message should be followed
+ by one "Nicely killing" message for each extant child.
+ =item CRITICAL Now kill children nasty
+ In the parent's INT handler. remaining children are about to be killed via
+ SIGKILL. Should be followed by a Nastily killing... for each lonc child that
+ refused to die.
+ =item CRITICAL Master process exiting
+ In the parent's INT handler. just prior to the exit 0 call.
+ =back
+ =cut

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

Removed from v.1.41
changed lines
	Added in v.1.90