--- loncom/loncnew 2004/02/09 10:58:03 1.40 +++ loncom/loncnew 2005/01/19 21:38:25 1.57.2.1 @@ -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.57.2.1 2005/01/19 21:38:25 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,6 +61,7 @@ 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 @@ -82,7 +83,7 @@ my $ClientConnection = 0; # Uniquifier f my $DebugLevel = 0; my $NextDebugLevel= 2; # So Sigint can toggle this. -my $IdleTimeout= 3600; # Wait an hour before pruning connections. +my $IdleTimeout= 600; # Wait 10 minutes before pruning connections. my $LogTransactions = 0; # When True, all transactions/replies get logged. @@ -103,6 +104,10 @@ my $RecentLogEntry = ""; my $ConnectionRetries=2; # Number of connection retries allowed. my $ConnectionRetriesLeft=2; # 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 $DieWhenIdle = 0; # When true children die when trimmed -> 0. # # The hash below gives the HTML format for log messages @@ -110,13 +115,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 @@ -156,9 +175,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"; } @@ -193,8 +212,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 +238,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. } } @@ -260,11 +283,19 @@ sub ShowStatus { 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; + } + } #----------------------------- Timer management ------------------------ @@ -278,13 +309,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 +324,22 @@ 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) && $DieWhenIdle) { + # + # 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); + + exit(0); + } } } else { $IdleSeconds = 0; # Reset idle count if not idle. @@ -312,28 +358,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 @@ -374,6 +425,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"); @@ -453,7 +505,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(); @@ -506,8 +558,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. @@ -521,7 +573,9 @@ sub CompleteTransaction { unlink $Transaction->getFile(); } } + =pod + =head1 StartClientReply Initiates a reply to a client where the reply data is a parameter. @@ -537,10 +591,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 +608,9 @@ sub StartClientReply { cb => \&ClientWritable, data => $data); } + =pod + =head2 FailTransaction Finishes a transaction with failure because the associated lond socket @@ -564,8 +620,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,20 +628,24 @@ Parameters: The LondTransaction we are failing. + =cut sub FailTransaction { my $transaction = shift; - Log("WARNING", "Failing transaction ".$transaction->getRequest()); + + # If the socket is dead, that's already logged. + + if ($ConnectionRetriesLeft > 0) { + Log("WARNING", "Failing transaction " + .$transaction->getRequest()); + } Debug(1, "Failing transaction: ".$transaction->getRequest()); 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()); - } } @@ -614,7 +673,10 @@ Close all connections open on lond prior =cut sub CloseAllLondConnections { foreach my $Socket (keys %ActiveConnections) { - KillSocket($Socket); + if(exists($ActiveTransactions{$Socket})) { + FailTransaction($ActiveTransactions{$Socket}); + } + KillSocket($Socket); } } =cut @@ -666,6 +728,7 @@ sub KillSocket { # if($ConnectionCount == 0) { EmptyQueue(); + CloseAllLondConnections; # Should all already be closed but... } } @@ -740,119 +803,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); + Deubg(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,131 +1004,112 @@ 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: - $Watcher->cb(\&LondReadable); - $Watcher->poll("r"); + if ($State eq "Connected") { - } 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) { + # "init" is being sent... + + } elsif ($State eq "Initialized") { - $Watcher->cancel(); - KillSocket($Socket); - return; - } + # Now that init was sent, we switch + # to watching for readability: + + $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 "ReceivingKey") { - # Now we need to wait for the key - # to come back from the peer: + } 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: - $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 @@ -1133,7 +1186,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: @@ -1141,6 +1196,7 @@ sub MakeLondConnection { } Log("SUCESS", "Created connection ".$ConnectionCount ." to host ".GetServerHost()); + $LondConnecting = 1; # Connection in progress. return 1; # Return success. } @@ -1172,8 +1228,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 +1280,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,7 +1336,7 @@ 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") { Log("CRITICAL", "Request Close Connection ... exiting"); @@ -1384,7 +1445,7 @@ sub SetupLoncListener { my $SocketName = GetLoncSocketPath(); unlink($SocketName); unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, - Listen => 10, + Listen => 250, Type => SOCK_STREAM)) { die "Failed to create a lonc listner socket"; } @@ -1422,29 +1483,36 @@ 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; } @@ -1515,7 +1583,6 @@ sub ChildProcess { cb => \&ToggleDebug, data => "INT"); - SetupTimer(); SetupLoncListener(); @@ -1538,9 +1605,10 @@ sub ChildProcess { # Create a new child for host passed in: sub CreateChild { + my $host = shift; + my $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset); - my $host = shift; $RemoteHost = $host; Log("CRITICAL", "Forking server for ".$host); my $pid = fork; @@ -1667,7 +1735,6 @@ sub CheckKids { foreach my $pid (keys %ChildHash) { Debug(2, "Sending USR1 -> $pid"); kill 'USR1' => $pid; # Tell Child to report status. - sleep 1; # Wait so file doesn't intermix. } } @@ -1811,17 +1878,33 @@ sub KillThemAll { 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"); + 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"); + } + +# +# 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 %ChildHash) { + my $serving = $ChildHash{$pid}; + &ShowStatus("Nastily killing lonc for $serving pid = $pid"); + Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid"); + kill 'KILL' => $pid; + delete($ChildHash{$pid}); + my $execdir = $perlvar{'lonDaemons'}; + unlink("$execdir/logs/lonc.pid"); + } +} =pod =head1 Terminate @@ -1831,7 +1914,15 @@ 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;