--- loncom/loncnew 2004/10/05 10:10:31 1.64 +++ 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.64 2004/10/05 10:10:31 foxr Exp $ +# $Id: loncnew,v 1.76 2006/08/25 21:12:19 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 @@ -79,6 +80,8 @@ my %listening_to; # Socket->host table # 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. @@ -87,6 +90,7 @@ my $NextDebugLevel= 2; # So Sigint can my $IdleTimeout= 600; # Wait 10 minutes 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. @@ -102,16 +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. -# DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!! -my $DieWhenIdle = 0; # When true children die when trimmed -> 0. +my $DieWhenIdle = 1; # When true children die when trimmed -> 0. my $I_am_child = 0; # True if this is the child process. # @@ -149,6 +152,7 @@ sub UpdateStatus { Makes an entry into the permanent log file. =cut + sub LogPerm { my $message=shift; my $execdir=$perlvar{'lonDaemons'}; @@ -194,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. @@ -268,6 +272,7 @@ sub SocketDump { and as what we return in a SIGUSR1 =cut + sub ShowStatus { my $state = shift; my $now = time; @@ -278,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"); @@ -417,6 +423,7 @@ sub Tick { $KeyMode = ""; $clock_watcher->cancel(); } + &UpdateStatus(); } =pod @@ -670,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()); @@ -682,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()) { @@ -703,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})) { @@ -711,7 +721,6 @@ sub CloseAllLondConnections { KillSocket($Socket); } } -=cut =pod @@ -733,8 +742,8 @@ Parameters: nonzero if we are allowed to create a new connection. - =cut + sub KillSocket { my $Socket = shift; @@ -946,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); @@ -1147,6 +1156,7 @@ sub LondWritable { =pod =cut + sub QueueDelayed { Debug(3,"QueueDelayed called"); @@ -1154,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); } @@ -1555,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 { @@ -1563,26 +1583,31 @@ sub ChildStatus { 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: # if ($DebugLevel > 2) { - print $fh "Active connection statuses: \n"; + 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 $fh "Connection $i State: $state\n"; + 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 @@ -1603,12 +1628,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. @@ -1624,6 +1651,8 @@ sub ToggleDebug { } +=pod + =head2 ChildProcess This sub implements a child process for a single lonc daemon. @@ -1650,9 +1679,19 @@ sub ChildProcess { Debug(5, "Killing watcher for $listener"); $watcher->cancel(); - undef $parent_dispatchers{$listener}; + 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. @@ -1692,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); @@ -1845,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(); @@ -1965,6 +2004,28 @@ if ($DieWhenIdle) { signal => "CHLD"); + # Set up all the other signals we set up. We'll vector them off to the + # same subs as we would for DieWhenIdle false and, if necessary, conditionalize + # the code there. + + $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 => \&Restart, + 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(); @@ -2016,11 +2077,14 @@ sub CheckKids { my $now=time; my $local=localtime($now); print $fh "LONC status $local - parent $$ \n\n"; + foreach my $host (keys %parent_dispatchers) { + print $fh "LONC Parent process listening for $host\n"; + } 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. } + } =pod @@ -2053,81 +2117,15 @@ 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. - # + # 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). - # For each existing child; if it's host doesn't exist, kill the child. + &Restart(); - 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. - } - } } @@ -2146,7 +2144,7 @@ sub Restart { Log("CRITICAL", "Restarting"); my $execdir = $perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); - exec("$execdir/loncnew"); + exec("$executable"); } =pod @@ -2190,6 +2188,7 @@ sub really_kill_them_all_dammit unlink("$execdir/logs/lonc.pid"); } } + =pod =head1 Terminate