--- loncom/loncnew 2005/03/15 01:12:20 1.68 +++ loncom/loncnew 2006/08/25 21:12:19 1.76 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.68 2005/03/15 01:12:20 albertel Exp $ +# $Id: loncnew,v 1.76 2006/08/25 21:12:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -106,8 +106,8 @@ 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. @@ -152,6 +152,7 @@ sub UpdateStatus { Makes an entry into the permanent log file. =cut + sub LogPerm { my $message=shift; my $execdir=$perlvar{'lonDaemons'}; @@ -197,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. @@ -271,6 +272,7 @@ sub SocketDump { and as what we return in a SIGUSR1 =cut + sub ShowStatus { my $state = shift; my $now = time; @@ -281,13 +283,14 @@ 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"); @@ -674,9 +677,9 @@ sub FailTransaction { if ($ConnectionRetriesLeft > 0) { Log("WARNING", "Failing transaction " - .$transaction->getRequest()); + .$transaction->getLoggableRequest()); } - Debug(1, "Failing transaction: ".$transaction->getRequest()); + 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()); @@ -686,12 +689,14 @@ sub FailTransaction { } =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()) { @@ -707,6 +712,7 @@ sub EmptyQueue { Close all connections open on lond prior to exit e.g. =cut + sub CloseAllLondConnections { foreach my $Socket (keys %ActiveConnections) { if(exists($ActiveTransactions{$Socket})) { @@ -715,7 +721,6 @@ sub CloseAllLondConnections { KillSocket($Socket); } } -=cut =pod @@ -737,8 +742,8 @@ Parameters: nonzero if we are allowed to create a new connection. - =cut + sub KillSocket { my $Socket = shift; @@ -950,7 +955,7 @@ sub LondReadable { # 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); @@ -1151,6 +1156,7 @@ sub LondWritable { =pod =cut + sub QueueDelayed { Debug(3,"QueueDelayed called"); @@ -1158,19 +1164,28 @@ sub QueueDelayed { Debug(4, "Delayed path: ".$path); opendir(DIRHANDLE, $path); - - my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; + + my @all_host_ids; + my $host_iterator = &LondConnection::GetHostIterator(); + while (!$host_iterator->end()) { + my ($host_id,$host_name) = @{$host_iterator->get()}[0,3]; + if ($host_name eq $RemoteHost) { + push(@all_host_ids, $host_id); + } + $host_iterator->next(); + } + my $host_id_re = '(?:'.join('|',@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); } @@ -1559,6 +1574,7 @@ 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 { @@ -1591,6 +1607,7 @@ sub ChildStatus { flock(LOG,LOCK_UN); close(LOG); $ConnectionRetriesLeft = $ConnectionRetries; + UpdateStatus(); } =pod @@ -1617,6 +1634,8 @@ sub SignalledToDeath { } +=pod + =head2 ToggleDebug This sub toggles trace debugging on and off. @@ -1632,6 +1651,8 @@ sub ToggleDebug { } +=pod + =head2 ChildProcess This sub implements a child process for a single lonc daemon. @@ -1710,7 +1731,7 @@ sub ChildProcess { desc => 'Lonc Listener Unix Socket', fd => $socket); - $Event::Debuglevel = $DebugLevel; + $Event::DebugLevel = $DebugLevel; Debug(9, "Making initial lond connection for ".$RemoteHost); @@ -1863,7 +1884,7 @@ sub listen_on_all_unix_sockets { my $host_iterator = &LondConnection::GetHostIterator(); while (!$host_iterator->end()) { my $host_entry_ref = $host_iterator->get(); - my $host_name = $host_entry_ref->[0]; + my $host_name = $host_entry_ref->[3]; Debug(9, "Listen for $host_name"); &parent_listen($host_name); $host_iterator->next(); @@ -2167,6 +2188,7 @@ sub really_kill_them_all_dammit unlink("$execdir/logs/lonc.pid"); } } + =pod =head1 Terminate