--- loncom/loncnew 2004/02/09 10:58:03 1.40 +++ loncom/loncnew 2011/01/20 11:19:37 1.94 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.40 2004/02/09 10:58:03 foxr Exp $ +# $Id: loncnew,v 1.94 2011/01/20 11:19:37 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,7 +60,7 @@ 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 @@ -72,24 +72,30 @@ my %perlvar = %{$perlvarref}; # # parent and shared variables. -my %ChildHash; # by pid -> host. -my %HostToPid; # By host -> pid. -my %HostHash; # by loncapaname -> IP. +my %ChildPid; # by pid -> host. +my %ChildHost; # by host. +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= 5*60; # Seconds to wait prior to 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. @@ -100,9 +106,15 @@ 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 $ConnectionRetriesLeft=2; # Number of connection retries remaining. +my $ConnectionRetries=5; # Number of connection retries allowed. +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 @@ -110,13 +122,27 @@ my $LondVersion = "unknown"; # Versi # my %LogFormats; -$LogFormats{"CRITICAL"} = "CRITICAL: %s"; -$LogFormats{"SUCCESS"} = "SUCCESS: %s"; -$LogFormats{"INFO"} = "INFO: %s"; -$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; $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 @@ -125,12 +151,14 @@ $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"; } @@ -156,9 +184,9 @@ 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"; } @@ -170,7 +198,7 @@ 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. @@ -193,8 +221,10 @@ 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; @@ -217,18 +247,20 @@ 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. } } @@ -240,6 +272,7 @@ sub SocketDump { and as what we return in a SIGUSR1 =cut + sub ShowStatus { my $state = shift; my $now = time; @@ -250,21 +283,65 @@ 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: "); - $Socket->Dump(); + Debug(5, " SocketTimeout called: "); + $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 ------------------------ @@ -278,13 +355,12 @@ Invoked each timer tick. sub Tick { + my ($Event) = @_; + my $clock_watcher = $Event->w; + my $client; - if($ConnectionRetriesLeft > 0) { - ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount - ." Retries remaining: ".$ConnectionRetriesLeft); - } else { - ShowStatus(GetServerHost()." >> DEAD <<"); - } + UpdateStatus(); + # Is it time to prune connection count: @@ -294,6 +370,12 @@ 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. @@ -312,28 +394,33 @@ 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) ? - $Requests : $MaxConnectionCount; - Debug(5,"Work but no connections, start ".$Connections." of them"); - my $successCount = 0; - for (my $i =0; $i < $Connections; $i++) { - $successCount += MakeLondConnection(); - } - if($successCount == 0) { # All connections failed: + Debug(5,"Work but no connections, Make a new one"); + my $success; + $success = &MakeLondConnection; + if($success == 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 @@ -354,7 +441,8 @@ Trigger disconnections of idle sockets. sub SetupTimer { Debug(6, "SetupTimer"); - Event->timer(interval => 1, cb => \&Tick ); + Event->timer(interval => 1, cb => \&Tick, + hard => 1); } =pod @@ -374,6 +462,7 @@ 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"); @@ -415,6 +504,9 @@ 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; @@ -453,7 +545,7 @@ 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(); @@ -478,6 +570,7 @@ sub ClientWritable { } } else { $Watcher->cancel(); # A delayed request...just cancel. + return; } } @@ -506,8 +599,8 @@ 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. @@ -517,11 +610,13 @@ sub CompleteTransaction { StartClientReply($Transaction, $data); } else { # Delete deferred transaction file. Log("SUCCESS", "A delayed transaction was completed"); - LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); - unlink $Transaction->getFile(); + LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest()); + unlink($Transaction->getFile()); } } + =pod + =head1 StartClientReply Initiates a reply to a client where the reply data is a parameter. @@ -537,10 +632,10 @@ 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(); @@ -554,7 +649,9 @@ sub StartClientReply { cb => \&ClientWritable, data => $data); } + =pod + =head2 FailTransaction Finishes a transaction with failure because the associated lond socket @@ -564,8 +661,7 @@ 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 -%ActiveTransactions hash. +Deleting the transaction means killing it from the %ActiveTransactions hash. Parameters: @@ -573,30 +669,36 @@ 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()) { @@ -612,12 +714,15 @@ 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 @@ -639,8 +744,8 @@ Parameters: nonzero if we are allowed to create a new connection. - =cut + sub KillSocket { my $Socket = shift; @@ -657,6 +762,7 @@ sub KillSocket { delete ($ActiveTransactions{$Socket}); } if(exists($ActiveConnections{$Socket})) { + $ActiveConnections{$Socket}->cancel; delete($ActiveConnections{$Socket}); $ConnectionCount--; if ($ConnectionCount < 0) { $ConnectionCount = 0; } @@ -666,7 +772,9 @@ sub KillSocket { # if($ConnectionCount == 0) { EmptyQueue(); + CloseAllLondConnections; # Should all already be closed but... } + UpdateStatus(); } =pod @@ -740,119 +848,128 @@ transaction is in progress, the socket a sub LondReadable { - my $Event = shift; - my $Watcher = $Event->w; - my $Socket = $Watcher->data; - my $client = undef; + my $Event = shift; + my $Watcher = $Event->w; + my $Socket = $Watcher->data; + my $client = undef; - &Debug(6,"LondReadable called state = ".$Socket->GetState()); + &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. - SocketDump(6, $Socket); - my $status = $Socket->Readable(); + SocketDump(6, $Socket); + my $status = $Socket->Readable(); - &Debug(2, "Socket->Readable returned: $status"); + &Debug(2, "Socket->Readable returned: $status"); - if($status != 0) { - # bad return from socket read. Currently this means that - # The socket has become disconnected. We fail the transaction. + if($status != 0) { + # bad return from socket read. Currently this means that + # The socket has become disconnected. We fail the transaction. - Log("WARNING", - "Lond connection lost."); - if(exists($ActiveTransactions{$Socket})) { - FailTransaction($ActiveTransactions{$Socket}); - } - $Watcher->cancel(); - KillSocket($Socket); - $ConnectionRetriesLeft--; # Counts as connection failure - return; - } - SocketDump(6,$Socket); + Log("WARNING", + "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); + $ConnectionRetriesLeft--; # Counts as connection failure + return; + } + SocketDump(6,$Socket); - $State = $Socket->GetState(); # Update in case of transition. - &Debug(6, "After read, state is ".$State); + $State = $Socket->GetState(); # Update in case of transition. + &Debug(6, "After read, state is ".$State); - if($State eq "Initialized") { + if($State eq "Initialized") { - } elsif ($State eq "ChallengeReceived") { + } elsif ($State eq "ChallengeReceived") { # The challenge must be echoed back; The state machine # in the connection takes care of setting that up. Just # need to transition to writable: + + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); - $Watcher->cb(\&LondWritable); - $Watcher->poll("w"); + } elsif ($State eq "ChallengeReplied") { - } elsif ($State eq "ChallengeReplied") { + } elsif ($State eq "RequestingVersion") { + # Need to ask for the version... that is writiability: - } elsif ($State eq "RequestingVersion") { - # Need to ask for the version... that is writiability: - - $Watcher->cb(\&LondWritable); - $Watcher->poll("w"); - - } elsif ($State eq "ReadingVersionString") { - # Read the rest of the version string... - } elsif ($State eq "SetHost") { - # Need to request the actual domain get set... - - $Watcher->cb(\&LondWritable); - $Watcher->poll("w"); - } elsif ($State eq "HostSet") { - # Reading the 'ok' from the peer. - - } elsif ($State eq "RequestingKey") { + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); + + } elsif ($State eq "ReadingVersionString") { + # Read the rest of the version string... + } elsif ($State eq "SetHost") { + # Need to request the actual domain get set... + + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); + } elsif ($State eq "HostSet") { + # Reading the 'ok' from the peer. + + } elsif ($State eq "RequestingKey") { # The ok was received. Now we need to request the key # That requires us to be writable: - $Watcher->cb(\&LondWritable); - $Watcher->poll("w"); + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); - } elsif ($State eq "ReceivingKey") { + } elsif ($State eq "ReceivingKey") { - } elsif ($State eq "Idle") { + } elsif ($State eq "Idle") { - # This is as good a spot as any to get the peer version - # string: + # This is as good a spot as any to get the peer version + # string: - if($LondVersion eq "unknown") { - $LondVersion = $Socket->PeerVersion(); - Log("INFO", "Connected to lond version: $LondVersion"); - } + if($LondVersion eq "unknown") { + $LondVersion = $Socket->PeerVersion(); + Log("INFO", "Connected to lond version: $LondVersion"); + } # If necessary, complete a transaction and then go into the # 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(); - if(exists($ActiveTransactions{$Socket})) { - Debug(5,"Completing transaction!!"); - CompleteTransaction($Socket, - $ActiveTransactions{$Socket}); - } else { - Log("SUCCESS", "Connection ".$ConnectionCount." to " - .$RemoteHost." now ready for action"); - } - ServerToIdle($Socket); # Next work unit or idle. + $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count + $Watcher->cancel(); + if(exists($ActiveTransactions{$Socket})) { + Debug(5,"Completing transaction!!"); + CompleteTransaction($Socket, + $ActiveTransactions{$Socket}); + } else { + Log("SUCCESS", "Connection ".$ConnectionCount." to " + .$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") { + } 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"); - $Watcher->poll("w"); - $Watcher->cb(\&LondWritable); + Debug(6, "SendingRequest state encountered in readable"); + $Watcher->poll("w"); + $Watcher->cb(\&LondWritable); - } elsif ($State eq "ReceivingReply") { + } elsif ($State eq "ReceivingReply") { - } else { - # Invalid state. - Debug(4, "Invalid state in LondReadable"); - } + } else { + # Invalid state. + Debug(4, "Invalid state in LondReadable"); + } } =pod @@ -932,136 +1049,120 @@ 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. + # Old logic wrote in state specific code below, however + # That forces us at least through another invocation of + # this function after writability is possible again. + # This logic also factors out common code for handling + # 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}); + } else { + # In the process of conneting, so need to turn that off. + + $LondConnecting = 0; + } + $Watcher->cancel(); + KillSocket($Socket); + return; + } + - 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"); - FailTransaction($ActiveTransactions{$Socket}); - $Watcher->cancel(); - KillSocket($Socket); - return; - } - - # "init" is being sent... - - } elsif ($State eq "Initialized") { - # Now that init was sent, we switch - # to watching for readability: + if ($State eq "Connected") { - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); + # "init" is being sent... + + } elsif ($State eq "Initialized") { - } elsif ($State eq "ChallengeReceived") { - # We received the challenge, now we - # are echoing it back. This is a no-op, - # we're waiting for the state to change - - if($Socket->Writable() != 0) { + # Now that init was sent, we switch + # to watching for readability: - $Watcher->cancel(); - KillSocket($Socket); - return; - } + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); - } elsif ($State eq "ChallengeReplied") { - # The echo was sent back, so we switch - # to watching readability. - - $Watcher->cb(\&LondReadable); - $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 - # version string from the peer: - - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); + } elsif ($State eq "ChallengeReceived") { + # We received the challenge, now we + # are echoing it back. This is a no-op, + # we're waiting for the state to change + + } elsif ($State eq "ChallengeReplied") { + # The echo was sent back, so we switch + # to watching readability. + + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); + } elsif ($State eq "RequestingVersion") { + # Sending the peer a version request... + + } elsif ($State eq "ReadingVersionString") { + # Transition to read since we have sent the + # version command and now just need to read the + # version string from the peer: - } elsif ($State eq "SetHost") { - # Setting the remote domain... + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); - if($Socket->Writable() != 0) { - $Watcher->cancel(); - KillSocket($Socket); - return; - } - } elsif ($State eq "HostSet") { - # Back to readable to get the ok. + } elsif ($State eq "SetHost") { + # Setting the remote domain... + + } elsif ($State eq "HostSet") { + # Back to readable to get the ok. - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); - } 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 "RequestingKey") { + # At this time we're requesting the key. + # again, this is essentially a no-op. + + } elsif ($State eq "ReceivingKey") { + # Now we need to wait for the key + # to come back from the peer: - } - } elsif ($State eq "ReceivingKey") { - # Now we need to wait for the key - # to come back from the peer: - - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); - } elsif ($State eq "SendingRequest") { + } elsif ($State eq "SendingRequest") { - # At this time we are sending a request to the + # 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 + # data to come in for a reply. + Debug(8,"Writable sent request/receiving reply"); + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); - } elsif ($State eq "ReceivingReply") { - # The send has completed. Wait for the - # data to come in for a reply. - Debug(8,"Writable sent request/receiving reply"); - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); - - } else { - # Control only passes here on an error: - # the socket state does not match any - # of the known states... so an error - # must be logged. + } else { + # Control only passes here on an error: + # the socket state does not match any + # of the known states... so an error + # must be logged. - &Debug(4, "Invalid socket state ".$State."\n"); - } + &Debug(4, "Invalid socket state ".$State."\n"); + } } + =pod =cut + + sub QueueDelayed { Debug(3,"QueueDelayed called"); @@ -1069,19 +1170,19 @@ 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; - my $reqfile; - foreach $dfname (sort @alldelayed) { - $reqfile = "$path/$dfname"; - Debug(4, "queueing ".$reqfile); + foreach my $dfname (sort(@alldelayed)) { + my $reqfile = "$path/$dfname"; + my ($host_id) = ($dfname =~ /\.([^.]*)$/); + Debug(4, "queueing ".$reqfile." for $host_id"); 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); } @@ -1105,14 +1206,16 @@ 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 @@ -1120,7 +1223,7 @@ 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); } @@ -1133,7 +1236,9 @@ 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: @@ -1172,8 +1277,8 @@ 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()); @@ -1224,15 +1329,20 @@ 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: @@ -1275,15 +1385,24 @@ 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 eq "close_connection_exit\n") { + if($data =~ /\n$/) { # Request entirely read. + 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); @@ -1294,6 +1413,40 @@ 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 @@ -1312,21 +1465,8 @@ 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", - $ClientConnection); - Debug(9, "Creating event named: ".$description); - Event->io(cb => \&ClientRequest, - poll => 'r', - desc => $description, - data => "", - fd => $connection); - $ActiveClients{$connection} = $ClientConnection; - $ClientConnection++; + &accept_client($socket); } =pod @@ -1336,10 +1476,20 @@ 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 @@ -1356,6 +1506,18 @@ 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. @@ -1376,22 +1538,31 @@ 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, - poll => 'r', - desc => 'Lonc listener Unix Socket', - fd => $socket); + return $socket; } # @@ -1421,31 +1592,40 @@ 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"; - my $i = 1; - print STDERR "================================= Socket Status Dump:\n"; - foreach my $item (keys %ActiveConnections) { - my $Socket = $ActiveConnections{$item}->data; - my $state = $Socket->GetState(); - print $fh "Connection $i State: $state\n"; - print STDERR "---------------------- Connection $i \n"; - $Socket->Dump(); - $i++; + if ($DebugLevel > 2) { + print LOG "Active connection statuses: \n"; + my $i = 1; + print STDERR "================================= Socket Status Dump:\n"; + foreach my $item (keys %ActiveConnections) { + my $Socket = $ActiveConnections{$item}->data; + my $state = $Socket->GetState(); + print LOG "Connection $i State: $state\n"; + print STDERR "---------------------- Connection $i \n"; + $Socket->Dump(-1); # Ensure it gets dumped.. + $i++; + } } + flock(LOG,LOCK_UN); + close(LOG); $ConnectionRetriesLeft = $ConnectionRetries; + UpdateStatus(); } =pod @@ -1466,12 +1646,14 @@ sub SignalledToDeath { chomp($signal); Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " ."died through "."\"$signal\""); - LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " - ."\"$signal\""); + #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " +# ."\"$signal\""); exit 0; } +=pod + =head2 ToggleDebug This sub toggles trace debugging on and off. @@ -1487,18 +1669,54 @@ 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, @@ -1515,49 +1733,252 @@ sub ChildProcess { cb => \&ToggleDebug, data => "INT"); - SetupTimer(); - - SetupLoncListener(); + # Block the pipe signal we'll get when the socket disconnects. We detect + # socket disconnection via send/receive failures. On disconnect, the + # socket becomes readable .. which will force the disconnect detection. + + my $set = POSIX::SigSet->new(SIGPIPE); + sigprocmask(SIG_BLOCK, $set); + + # Figure out if we got passed a socket or need to open one to listen for + # client requests. + + 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; + ShowStatus('Parent keeping the flock'); # Update time in status message. Log("CRITICAL", "Forking server for ".$host); my $pid = fork; if($pid) { # Parent $RemoteHost = "Parent"; - $ChildHash{$pid} = $host; - $HostToPid{$host}= $pid; + $ChildPid{$pid} = $host; 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 @@ -1606,44 +2027,49 @@ 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(); - CreateChild($hostentryref->[0]); - $HostHash{$hostentryref->[0]} = $hostentryref->[4]; - $HostIterator->next(); -} +$RemoteHost = "[parent]"; +&listen_on_common_socket(); + $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 @@ -1664,11 +2090,14 @@ 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 @@ -1701,81 +2130,14 @@ 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. + # I'm not sure what I was thinking in the first implementation. + # someone will have to work hard to convince me the effect is any + # 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 + # (lost unless they are critical). - $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. - } - } + &KillThemAll(); } @@ -1794,7 +2156,7 @@ sub Restart { Log("CRITICAL", "Restarting"); my $execdir = $perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); - exec("$execdir/loncnew"); + exec("$executable"); } =pod @@ -1808,18 +2170,39 @@ 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) { - 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"); + + #local($SIG{CHLD}) = 'IGNORE'; + # Our children >will< die. + # but we need to catch their death and cleanup after them in case this is + # a restart set of kills + 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'}; - unlink("$execdir/logs/lonc.pid"); + ShowStatus("Finished killing child processes off."); +} + + +# +# 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 @@ -1831,11 +2214,27 @@ 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 @@ -1877,3 +2276,183 @@ 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 + +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: + +Can be enabled for debugging by setting LogTransactions to nonzero. +Indicates a successful transaction with lond, 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 : + +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: + +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 + +Only emitted if the global variable $LogTransactions was set to true. +A client has requested a lond transaction is the contents of the request. + +=item SUCCESS Toggled transaction logging + +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 for died thorugh signal. + +QUIT signal received. lonc child process is exiting. + +=item SUCCESS New debugging level for now + +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 = + +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 = + +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