version 1.74, 2006/01/27 20:37:12
|
version 1.85, 2007/05/01 01:04:23
|
Line 60 use LONCAPA::Stack;
|
Line 60 use LONCAPA::Stack;
|
use LONCAPA::LondConnection; |
use LONCAPA::LondConnection; |
use LONCAPA::LondTransaction; |
use LONCAPA::LondTransaction; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::HashIterator; |
|
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
|
|
|
Line 73 my %perlvar = %{$perlvarref};
|
Line 72 my %perlvar = %{$perlvarref};
|
# |
# |
# parent and shared variables. |
# parent and shared variables. |
|
|
my %ChildHash; # by pid -> host. |
my %ChildPid; # by pid -> host. |
my %HostToPid; # By host -> pid. |
my %ChildHost; # by host. |
my %HostHash; # by loncapaname -> IP. |
|
my %listening_to; # Socket->host table for who the parent |
my %listening_to; # Socket->host table for who the parent |
# is listening to. |
# is listening to. |
my %parent_dispatchers; # host-> listener watcher events. |
my %parent_dispatchers; # host-> listener watcher events. |
Line 96 my $executable = $0; # Get the full
|
Line 94 my $executable = $0; # Get the full
|
# The variables below are only used by the child processes. |
# The variables below are only used by the child processes. |
# |
# |
my $RemoteHost; # Name of host child is talking to. |
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 $UnixSocketDir= $perlvar{'lonSockDir'}; |
my $IdleConnections = Stack->new(); # Set of idle connections |
my $IdleConnections = Stack->new(); # Set of idle connections |
my %ActiveConnections; # Connections to the remote lond. |
my %ActiveConnections; # Connections to the remote lond. |
Line 114 my $LondConnecting = 0; # True wh
|
Line 114 my $LondConnecting = 0; # True wh
|
|
|
|
|
|
|
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 198 sub Log {
|
Line 197 sub Log {
|
my $now = time; |
my $now = time; |
my $local = localtime($now); |
my $local = localtime($now); |
my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; |
my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; |
my $finalformat = $finalformat.$format."\n"; |
$finalformat = $finalformat.$format."\n"; |
|
|
# open the file and put the result. |
# open the file and put the result. |
|
|
Line 308 sub SocketTimeout {
|
Line 307 sub SocketTimeout {
|
} |
} |
|
|
} |
} |
|
|
# |
# |
# This function should be called by the child in all cases where it must |
# 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 |
# exit. The child process must create a lock file for the AF_UNIX socket |
# it must create a lock file for the AF_UNIX socket in order to prevent |
# in order to prevent connection requests from lonnet in the time between |
# connection requests from lonnet in the time between process exit |
# process exit and the parent picking up the listen again. |
# and the parent picking up the listen again. |
# |
# Parameters: |
# Parameters: |
# exit_code - Exit status value, however see the next parameter. |
# exit_code - Exit status value, however see the next parameter. |
# message - If this optional parameter is supplied, the exit |
# message - If this optional parameter is supplied, the exit |
Line 324 sub child_exit {
|
Line 324 sub child_exit {
|
|
|
# Regardless of how we exit, we may need to do the lock thing: |
# 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 |
# Create a lock file since there will be a time window |
# between our exit and the parent's picking up the listen |
# between our exit and the parent's picking up the listen |
# during which no listens will be done on the |
# during which no listens will be done on the |
# lonnet client socket. |
# lonnet client socket. |
# |
# |
my $lock_file = &GetLoncSocketPath().".lock"; |
my $lock_file = GetLoncSocketPath().".lock"; |
open(LOCK,">$lock_file"); |
open(LOCK,">$lock_file"); |
print LOCK "Contents not important"; |
print LOCK "Contents not important"; |
close(LOCK); |
close(LOCK); |
unlink(&GetLoncSocketPath()); |
|
|
exit(0); |
|
} |
|
# Now figure out how we exit: |
|
|
|
if($message) { |
if ($message) { |
die $message; |
die($message); |
} else { |
} else { |
exit($exit_code); |
exit($exit_code); |
} |
} |
Line 375 sub Tick {
|
Line 371 sub Tick {
|
KillSocket($Socket); |
KillSocket($Socket); |
$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)) { |
&child_exit(0); |
&child_exit(0); |
|
|
} |
} |
Line 506 the data and Event->w->fd is the socket
|
Line 502 the data and Event->w->fd is the socket
|
sub ClientWritable { |
sub ClientWritable { |
my $Event = shift; |
my $Event = shift; |
my $Watcher = $Event->w; |
my $Watcher = $Event->w; |
|
if (!defined($Watcher)) { |
|
&child_exit(-1,'No watcher for event in ClientWritable'); |
|
} |
my $Data = $Watcher->data; |
my $Data = $Watcher->data; |
my $Socket = $Watcher->fd; |
my $Socket = $Watcher->fd; |
|
|
Line 569 sub ClientWritable {
|
Line 568 sub ClientWritable {
|
} |
} |
} else { |
} else { |
$Watcher->cancel(); # A delayed request...just cancel. |
$Watcher->cancel(); # A delayed request...just cancel. |
|
return; |
} |
} |
} |
} |
|
|
Line 1153 sub LondWritable {
|
Line 1153 sub LondWritable {
|
} |
} |
|
|
} |
} |
|
|
=pod |
=pod |
|
|
=cut |
=cut |
|
|
|
|
sub QueueDelayed { |
sub QueueDelayed { |
Debug(3,"QueueDelayed called"); |
Debug(3,"QueueDelayed called"); |
|
|
Line 1164 sub QueueDelayed {
|
Line 1166 sub QueueDelayed {
|
|
|
Debug(4, "Delayed path: ".$path); |
Debug(4, "Delayed path: ".$path); |
opendir(DIRHANDLE, $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); |
closedir(DIRHANDLE); |
my $dfname; |
foreach my $dfname (sort(@alldelayed)) { |
my $reqfile; |
my $reqfile = "$path/$dfname"; |
foreach $dfname (sort @alldelayed) { |
my ($host_id) = ($dfname =~ /\.([^.]*)$/); |
$reqfile = "$path/$dfname"; |
Debug(4, "queueing ".$reqfile." for $host_id"); |
Debug(4, "queueing ".$reqfile); |
|
my $Handle = IO::File->new($reqfile); |
my $Handle = IO::File->new($reqfile); |
my $cmd = <$Handle>; |
my $cmd = <$Handle>; |
chomp $cmd; # There may or may not be a newline... |
chomp $cmd; # There may or may not be a newline... |
$cmd = $cmd."\n"; # now for sure there's exactly one 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); |
$Transaction->SetDeferred($reqfile); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
} |
} |
Line 1200 sub MakeLondConnection {
|
Line 1202 sub MakeLondConnection {
|
.GetServerPort()); |
.GetServerPort()); |
|
|
my $Connection = LondConnection->new(&GetServerHost(), |
my $Connection = LondConnection->new(&GetServerHost(), |
&GetServerPort()); |
&GetServerPort(), |
|
&GetHostId()); |
|
|
if($Connection eq undef) { # Needs to be more robust later. |
if($Connection eq undef) { # Needs to be more robust later. |
Log("CRITICAL","Failed to make a connection with lond."); |
Log("CRITICAL","Failed to make a connection with lond."); |
Line 1208 sub MakeLondConnection {
|
Line 1211 sub MakeLondConnection {
|
return 0; # Failure. |
return 0; # Failure. |
} else { |
} else { |
|
|
|
$LondConnecting = 1; # Connection in progress. |
# The connection needs to have writability |
# The connection needs to have writability |
# monitored in order to send the init sequence |
# monitored in order to send the init sequence |
# that starts the whole authentication/key |
# that starts the whole authentication/key |
Line 1238 sub MakeLondConnection {
|
Line 1242 sub MakeLondConnection {
|
} |
} |
Log("SUCESS", "Created connection ".$ConnectionCount |
Log("SUCESS", "Created connection ".$ConnectionCount |
." to host ".GetServerHost()); |
." to host ".GetServerHost()); |
$LondConnecting = 1; # Connection in progress. |
|
return 1; # Return success. |
return 1; # Return success. |
} |
} |
|
|
Line 1401 sub ClientRequest {
|
Line 1404 sub ClientRequest {
|
# Accept a connection request for a client (lonc child) and |
# Accept a connection request for a client (lonc child) and |
# start up an event watcher to keep an eye on input from that |
# start up an event watcher to keep an eye on input from that |
# Event. This can be called both from NewClient and from |
# Event. This can be called both from NewClient and from |
# ChildProcess if we are started in DieWhenIdle mode. |
# ChildProcess. |
# Parameters: |
# Parameters: |
# $socket - The listener socket. |
# $socket - The listener socket. |
# Returns: |
# Returns: |
Line 1490 sub GetServerHost {
|
Line 1493 sub GetServerHost {
|
|
|
=pod |
=pod |
|
|
|
=head2 GetServerId |
|
|
|
Returns the hostid whose lond we talk with. |
|
|
|
=cut |
|
|
|
sub GetHostId { |
|
return $RemoteHostId; # Setup by the fork. |
|
} |
|
|
|
=pod |
|
|
=head2 GetServerPort |
=head2 GetServerPort |
|
|
Returns the lond port number. |
Returns the lond port number. |
Line 1517 another event handler to subess requests
|
Line 1532 another event handler to subess requests
|
=cut |
=cut |
|
|
sub SetupLoncListener { |
sub SetupLoncListener { |
|
my ($host,$SocketName) = @_; |
|
if (!$host) { $host = &GetServerHost(); } |
|
if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); } |
|
|
my $host = GetServerHost(); # Default host. |
|
if (@_) { |
|
($host) = @_ # Override host with parameter. |
|
} |
|
|
|
my $socket; |
|
my $SocketName = GetLoncSocketPath($host); |
|
unlink($SocketName); |
unlink($SocketName); |
|
|
|
my $socket; |
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)) { |
Line 1654 Optional parameter:
|
Line 1668 Optional parameter:
|
=cut |
=cut |
|
|
sub ChildProcess { |
sub ChildProcess { |
# If we are in DieWhenIdle mode, we've inherited all the |
# We've inherited all the |
# events of our parent and those have to be cancelled or else |
# events of our parent and those have to be cancelled or else |
# all holy bloody chaos will result.. trust me, I already made |
# all holy bloody chaos will result.. trust me, I already made |
# >that< mistake. |
# >that< mistake. |
Line 1722 sub ChildProcess {
|
Line 1736 sub ChildProcess {
|
desc => 'Lonc Listener Unix Socket', |
desc => 'Lonc Listener Unix Socket', |
fd => $socket); |
fd => $socket); |
|
|
$Event::Debuglevel = $DebugLevel; |
$Event::DebugLevel = $DebugLevel; |
|
|
Debug(9, "Making initial lond connection for ".$RemoteHost); |
Debug(9, "Making initial lond connection for ".$RemoteHost); |
|
|
Line 1730 sub ChildProcess {
|
Line 1744 sub ChildProcess {
|
|
|
# &MakeLondConnection(); // let first work request do it. |
# &MakeLondConnection(); // let first work request do it. |
|
|
# If We are in diwhenidle, need to accept the connection since the |
# need to accept the connection since the event may not fire. |
# event may not fire. |
|
|
|
if ($DieWhenIdle) { |
&accept_client($socket); |
&accept_client($socket); |
|
} |
|
|
|
Debug(9,"Entering event loop"); |
Debug(9,"Entering event loop"); |
my $ret = Event::loop(); # Start the main event loop. |
my $ret = Event::loop(); # Start the main event loop. |
Line 1747 sub ChildProcess {
|
Line 1758 sub ChildProcess {
|
# Create a new child for host passed in: |
# Create a new child for host passed in: |
|
|
sub CreateChild { |
sub CreateChild { |
my ($host, $socket) = @_; |
my ($host, $hostid) = @_; |
|
|
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
sigprocmask(SIG_BLOCK, $sigset); |
sigprocmask(SIG_BLOCK, $sigset); |
Line 1756 sub CreateChild {
|
Line 1767 sub CreateChild {
|
my $pid = fork; |
my $pid = fork; |
if($pid) { # Parent |
if($pid) { # Parent |
$RemoteHost = "Parent"; |
$RemoteHost = "Parent"; |
$ChildHash{$pid} = $host; |
$ChildPid{$pid} = $host; |
$HostToPid{$host}= $pid; |
|
sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
|
undef(@all_host_ids); |
} else { # child. |
} else { # child. |
|
$RemoteHostId = $hostid; |
ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
$SIG{INT} = 'DEFAULT'; |
$SIG{INT} = 'DEFAULT'; |
sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
if(defined $socket) { |
&ChildProcess(); # Does not return. |
&ChildProcess($socket); |
|
} else { |
|
ChildProcess; # Does not return. |
|
} |
|
} |
} |
} |
} |
|
|
Line 1796 sub parent_client_connection {
|
Line 1803 sub parent_client_connection {
|
my ($event) = @_; |
my ($event) = @_; |
my $watcher = $event->w; |
my $watcher = $event->w; |
my $socket = $watcher->fd; |
my $socket = $watcher->fd; |
|
my $connection = $socket->accept(); # Accept the client connection. |
# Lookup the host associated with this socket: |
Event->io(cb => \&get_remote_hostname, |
|
poll => 'r', |
my $host = $listening_to{$socket}; |
data => "", |
|
fd => $connection); |
# Start the child: |
|
|
|
|
|
|
|
&Debug(9,"Creating child for $host (parent_client_connection)"); |
|
&CreateChild($host, $socket); |
|
|
|
# Clean up the listen since now the child takes over until it exits. |
|
|
|
$watcher->cancel(); # Nolonger listening to this event |
|
delete($listening_to{$socket}); |
|
delete($parent_dispatchers{$host}); |
|
$socket->close(); |
|
} |
} |
} |
} |
|
|
|
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: |
# parent_listen: |
# Opens a socket and starts a listen for the parent process on a client UNIX |
# Opens a socket and starts a listen for the parent process on a client UNIX |
# domain socket. |
# domain socket. |
Line 1836 sub parent_listen {
|
Line 1868 sub parent_listen {
|
my ($loncapa_host) = @_; |
my ($loncapa_host) = @_; |
Debug(5, "parent_listen: $loncapa_host"); |
Debug(5, "parent_listen: $loncapa_host"); |
|
|
my $socket = &SetupLoncListener($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; |
$listening_to{$socket} = $loncapa_host; |
if (!$socket) { |
if (!$socket) { |
die "Unable to create a listen socket for $loncapa_host"; |
die "Unable to create a listen socket for $loncapa_host"; |
} |
} |
|
|
my $lock_file = &GetLoncSocketPath($loncapa_host).".lock"; |
my $lock_file = $file.".lock"; |
unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] |
unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] |
|
|
my $watcher = Event->io(cb => \&parent_client_connection, |
my $watcher = |
poll => 'r', |
Event->io(cb => \&parent_client_connection, |
desc => "Parent listener unix socket ($loncapa_host)", |
poll => 'r', |
fd => $socket); |
desc => "Parent listener unix socket ($loncapa_host)", |
|
data => "", |
|
fd => $socket); |
$parent_dispatchers{$loncapa_host} = $watcher; |
$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.] |
|
} |
|
|
|
|
|
|
# listen_on_all_unix_sockets: |
# This sub initiates a listen on the common unix domain lonc client socket. |
# This sub initiates a listen on all unix domain lonc client sockets. |
# loncnew starts up with no children, and only spawns off children when a |
# This will be called in the case where we are trimming idle processes. |
# connection request occurs on the common client unix socket. The spawned |
# When idle processes are trimmed, loncnew starts up with no children, |
# child continues to run until it has been idle a while at which point it |
# and only spawns off children when a connection request occurs on the |
# eventually exits and once more the parent picks up the listen. |
# 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: |
# Parameters: |
# NONE |
# NONE |
Line 1870 sub parent_listen {
|
Line 1920 sub parent_listen {
|
# Returns: |
# Returns: |
# NONE |
# NONE |
# |
# |
sub listen_on_all_unix_sockets { |
sub listen_on_common_socket { |
Debug(5, "listen_on_all_unix_sockets"); |
Debug(5, "listen_on_common_socket"); |
my $host_iterator = &LondConnection::GetHostIterator(); |
&parent_listen(); |
while (!$host_iterator->end()) { |
|
my $host_entry_ref = $host_iterator->get(); |
|
my $host_name = $host_entry_ref->[3]; |
|
Debug(9, "Listen for $host_name"); |
|
&parent_listen($host_name); |
|
$host_iterator->next(); |
|
} |
|
} |
} |
|
|
# server_died is called whenever a child process exits. |
# server_died is called whenever a child process exits. |
Line 1901 sub server_died {
|
Line 1944 sub server_died {
|
} |
} |
# need the host to restart: |
# need the host to restart: |
|
|
my $host = $ChildHash{$pid}; |
my $host = $ChildPid{$pid}; |
if($host) { # It's for real... |
if($host) { # It's for real... |
&Debug(9, "Caught sigchild for $host"); |
&Debug(9, "Caught sigchild for $host"); |
delete($ChildHash{$pid}); |
delete($ChildPid{$pid}); |
delete($HostToPid{$host}); |
delete($ChildHost{$host}); |
&parent_listen($host); |
&parent_clean_up($host); |
|
|
} else { |
} else { |
&Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); |
&Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); |
Line 1963 ShowStatus("Forking node servers");
|
Line 2006 ShowStatus("Forking node servers");
|
Log("CRITICAL", "--------------- Starting children ---------------"); |
Log("CRITICAL", "--------------- Starting children ---------------"); |
|
|
LondConnection::ReadConfig; # Read standard config files. |
LondConnection::ReadConfig; # Read standard config files. |
my $HostIterator = LondConnection::GetHostIterator; |
|
|
|
if ($DieWhenIdle) { |
$RemoteHost = "[parent]"; |
$RemoteHost = "[parent]"; |
&listen_on_common_socket(); |
&listen_on_all_unix_sockets(); |
|
} else { |
|
|
|
while (! $HostIterator->end()) { |
|
|
|
my $hostentryref = $HostIterator->get(); |
|
CreateChild($hostentryref->[0]); |
|
$HostHash{$hostentryref->[0]} = $hostentryref->[4]; |
|
$HostIterator->next(); |
|
} |
|
} |
|
|
|
$RemoteHost = "Parent Server"; |
$RemoteHost = "Parent Server"; |
|
|
Line 1986 $RemoteHost = "Parent Server";
|
Line 2017 $RemoteHost = "Parent Server";
|
ShowStatus("Parent keeping the flock"); |
ShowStatus("Parent keeping the flock"); |
|
|
|
|
if ($DieWhenIdle) { |
# We need to setup a SIGChild event to handle the exit (natural or otherwise) |
# We need to setup a SIGChild event to handle the exit (natural or otherwise) |
# of the children. |
# 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; |
|
Debug(9, "Parent entering event loop"); |
|
my $ret = Event::loop(); |
|
die "Main Event loop exited: $ret"; |
|
|
|
|
|
} else { |
|
# |
|
# 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); |
|
} |
|
} |
|
} |
|
|
|
|
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 |
=pod |
|
|
Line 2071 sub CheckKids {
|
Line 2072 sub CheckKids {
|
foreach my $host (keys %parent_dispatchers) { |
foreach my $host (keys %parent_dispatchers) { |
print $fh "LONC Parent process listening for $host\n"; |
print $fh "LONC Parent process listening for $host\n"; |
} |
} |
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildPid) { |
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. |
} |
} |
Line 2115 sub UpdateKids {
|
Line 2116 sub UpdateKids {
|
# The down side is transactions that are in flight will get timed out |
# The down side is transactions that are in flight will get timed out |
# (lost unless they are critical). |
# (lost unless they are critical). |
|
|
&Restart(); |
&KillThemAll(); |
|
|
} |
} |
|
|
|
|
Line 2149 SIGHUP. Responds to sigint and sigterm.
|
Line 2149 SIGHUP. Responds to sigint and sigterm.
|
|
|
sub KillThemAll { |
sub KillThemAll { |
Debug(2, "Kill them all!!"); |
Debug(2, "Kill them all!!"); |
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
|
foreach my $pid (keys %ChildHash) { |
#local($SIG{CHLD}) = 'IGNORE'; |
my $serving = $ChildHash{$pid}; |
# 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"); |
ShowStatus("Nicely Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); |
kill 'QUIT' => $pid; |
kill 'QUIT' => $pid; |
} |
} |
|
ShowStatus("Finished killing child processes off."); |
|
|
} |
} |
|
|
|
|
Line 2169 sub really_kill_them_all_dammit
|
Line 2173 sub really_kill_them_all_dammit
|
{ |
{ |
Debug(2, "Kill them all Dammit"); |
Debug(2, "Kill them all Dammit"); |
local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them. |
local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them. |
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildPid) { |
my $serving = $ChildHash{$pid}; |
my $serving = $ChildPid{$pid}; |
&ShowStatus("Nastily killing lonc for $serving pid = $pid"); |
&ShowStatus("Nastily killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid"); |
kill 'KILL' => $pid; |
kill 'KILL' => $pid; |
delete($ChildHash{$pid}); |
delete($ChildPid{$pid}); |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
} |
} |
Line 2202 sub Terminate {
|
Line 2206 sub Terminate {
|
exit 0; |
exit 0; |
|
|
} |
} |
|
|
|
sub my_hostname { |
|
use Sys::Hostname; |
|
my $name = &hostname(); |
|
&Debug(9,"Name is $name"); |
|
return $name; |
|
} |
|
|
=pod |
=pod |
|
|
=head1 Theory |
=head1 Theory |