version 1.62, 2004/10/04 10:30:50
|
version 1.65, 2004/10/05 11:16:57
|
Line 79 my %listening_to; # Socket->host table
|
Line 79 my %listening_to; # Socket->host table
|
# is listening to. |
# is listening to. |
my %parent_dispatchers; # host-> listener watcher events. |
my %parent_dispatchers; # host-> listener watcher events. |
|
|
|
my %parent_handlers; # Parent signal handlers... |
|
|
my $MaxConnectionCount = 10; # Will get from config later. |
my $MaxConnectionCount = 10; # Will get from config later. |
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
Line 87 my $NextDebugLevel= 2; # So Sigint can
|
Line 89 my $NextDebugLevel= 2; # So Sigint can
|
my $IdleTimeout= 600; # Wait 10 minutes before pruning connections. |
my $IdleTimeout= 600; # Wait 10 minutes before pruning connections. |
|
|
my $LogTransactions = 0; # When True, all transactions/replies get logged. |
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. |
# The variables below are only used by the child processes. |
Line 109 my $KeyMode = ""; # e.g. s
|
Line 112 my $KeyMode = ""; # e.g. s
|
my $LondConnecting = 0; # True when a connection is being built. |
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. |
my $I_am_child = 0; # True if this is the child process. |
|
|
# |
# |
Line 302 sub SocketTimeout {
|
Line 304 sub SocketTimeout {
|
} |
} |
|
|
} |
} |
|
# |
|
# This function should be called by the child in all cases where it must |
|
# exit. If the child process is running with the DieWhenIdle turned on |
|
# it 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: |
|
|
|
if($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); |
|
} |
|
# Now figure out how we exit: |
|
|
|
if($message) { |
|
die $message; |
|
} else { |
|
exit($exit_code); |
|
} |
|
} |
#----------------------------- Timer management ------------------------ |
#----------------------------- Timer management ------------------------ |
|
|
=pod |
=pod |
Line 332 sub Tick {
|
Line 372 sub Tick {
|
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
UpdateStatus(); |
UpdateStatus(); |
if(($ConnectionCount == 0) && $DieWhenIdle) { |
if(($ConnectionCount == 0) && $DieWhenIdle) { |
# |
&child_exit(0); |
# 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 { |
} else { |
Line 1177 sub MakeLondConnection {
|
Line 1207 sub MakeLondConnection {
|
# |
# |
my $Socket = $Connection->GetSocket(); |
my $Socket = $Connection->GetSocket(); |
if($Socket eq undef) { |
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 { |
} else { |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
} |
} |
Line 1491 sub SetupLoncListener {
|
Line 1521 sub SetupLoncListener {
|
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
Listen => 250, |
Listen => 250, |
Type => SOCK_STREAM)) { |
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"; |
|
} |
} |
} |
return $socket; |
return $socket; |
} |
} |
Line 1618 sub ChildProcess {
|
Line 1652 sub ChildProcess {
|
Debug(5, "Killing watcher for $listener"); |
Debug(5, "Killing watcher for $listener"); |
|
|
$watcher->cancel(); |
$watcher->cancel(); |
undef $parent_dispatchers{$listener}; |
delete($parent_dispatchers{$listener}); |
|
|
} |
} |
$I_am_child = 1; # Seems like in spite of it all I'm still getting |
|
# parent event dispatches. |
# 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. |
|
|
|
|
# |
# |
Line 1679 sub ChildProcess {
|
Line 1723 sub ChildProcess {
|
my $ret = Event::loop(); # Start the main 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: |
# Create a new child for host passed in: |
Line 1716 sub CreateChild {
|
Line 1760 sub CreateChild {
|
# a connection request arrives. We must: |
# a connection request arrives. We must: |
# Start a child process to accept the connection request. |
# Start a child process to accept the connection request. |
# Kill our listen on the socket. |
# Kill our listen on the socket. |
# Setup an event to handle the child process exit. (SIGCHLD). |
|
# Parameter: |
# Parameter: |
# event - The event object that was created to monitor this socket. |
# event - The event object that was created to monitor this socket. |
# event->w->fd is the socket. |
# event->w->fd is the socket. |
Line 1821 sub listen_on_all_unix_sockets {
|
Line 1864 sub listen_on_all_unix_sockets {
|
} |
} |
} |
} |
|
|
|
# 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 = $ChildHash{$pid}; |
|
if($host) { # It's for real... |
|
&Debug(9, "Caught sigchild for $host"); |
|
delete($ChildHash{$pid}); |
|
delete($HostToPid{$host}); |
|
&parent_listen($host); |
|
|
|
} else { |
|
&Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); |
|
} |
|
} |
|
|
|
} |
|
|
# |
# |
# Parent process logic pass 1: |
# Parent process logic pass 1: |
# For each entry in the hosts table, we will |
# For each entry in the hosts table, we will |
Line 1893 ShowStatus("Parent keeping the flock");
|
Line 1969 ShowStatus("Parent keeping the flock");
|
|
|
|
|
if ($DieWhenIdle) { |
if ($DieWhenIdle) { |
|
# 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. 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; |
$Event::DebugLevel = $DebugLevel; |
Debug(9, "Parent entering event loop"); |
Debug(9, "Parent entering event loop"); |
my $ret = Event::loop(); |
my $ret = Event::loop(); |
Line 1944 sub CheckKids {
|
Line 2050 sub CheckKids {
|
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
print $fh "LONC status $local - parent $$ \n\n"; |
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) { |
foreach my $pid (keys %ChildHash) { |
Debug(2, "Sending USR1 -> $pid"); |
Debug(2, "Sending USR1 -> $pid"); |
kill 'USR1' => $pid; # Tell Child to report status. |
kill 'USR1' => $pid; # Tell Child to report status. |
sleep 1; # Wait so file doesn't intermix. |
sleep 1; # Wait so file doesn't intermix. |
} |
} |
|
|
} |
} |
|
|
=pod |
=pod |
Line 1981 sub UpdateKids {
|
Line 2091 sub UpdateKids {
|
|
|
Log("INFO", "Updating connections via SIGUSR2"); |
Log("INFO", "Updating connections via SIGUSR2"); |
|
|
# Just in case we need to kill our own lonc, we wait a few seconds to |
# I'm not sure what I was thinking in the first implementation. |
# give it a chance to receive and relay lond's response to the |
# someone will have to work hard to convince me the effect is any |
# re-init command. |
# different than Restart, especially now that we don't start up |
# |
# per host servers automatically, may as well just restart. |
|
# The down side is transactions that are in flight will get timed out |
sleep(2); # Wait a couple of seconds. |
# (lost unless they are critical). |
|
|
my %hosts; # Indexed by loncapa hostname, value=ip. |
|
|
|
# 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..."); |
&Restart(); |
delete $ChildHash{$child}; |
|
delete $HostToPid{$oldhost}; |
|
kill 'QUIT' => $child; |
|
|
|
# Do the book-keeping needed to start a new child on the |
|
# new ip. |
|
|
|
$HostHash{$oldhost} = $hosts{$oldhost}; |
|
CreateChild($oldhost); |
|
} |
|
} |
|
# Finally, for each new host, not in the host hash, create a |
|
# enter the host and create a new child. |
|
# Force a status display of any existing process. |
|
|
|
foreach my $host (keys %hosts) { |
|
if(!(exists $HostHash{$host})) { |
|
Log("INFO", "New host $host discovered in hosts.tab..."); |
|
$HostHash{$host} = $hosts{$host}; |
|
CreateChild($host); |
|
} else { |
|
kill 'HUP' => $HostToPid{$host}; # status display. |
|
} |
|
} |
|
} |
} |
|
|
|
|
Line 2074 sub Restart {
|
Line 2118 sub Restart {
|
Log("CRITICAL", "Restarting"); |
Log("CRITICAL", "Restarting"); |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
exec("$execdir/loncnew"); |
exec("$executable"); |
} |
} |
|
|
=pod |
=pod |