version 1.81, 2007/03/28 20:28:29
|
version 1.87, 2007/06/18 22:49:52
|
Line 72 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 %ChildHost; # by host. |
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 94 my $executable = $0; # Get the full
|
Line 95 my $executable = $0; # Get the full
|
# |
# |
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 $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 156 sub LogPerm {
|
Line 158 sub LogPerm {
|
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); |
my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); |
|
chomp($message); |
print $fh "$now:$message:$local\n"; |
print $fh "$now:$message:$local\n"; |
} |
} |
|
|
Line 500 the data and Event->w->fd is the socket
|
Line 503 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 563 sub ClientWritable {
|
Line 569 sub ClientWritable {
|
} |
} |
} else { |
} else { |
$Watcher->cancel(); # A delayed request...just cancel. |
$Watcher->cancel(); # A delayed request...just cancel. |
|
return; |
} |
} |
} |
} |
|
|
Line 602 sub CompleteTransaction {
|
Line 609 sub CompleteTransaction {
|
StartClientReply($Transaction, $data); |
StartClientReply($Transaction, $data); |
} else { # Delete deferred transaction file. |
} else { # Delete deferred transaction file. |
Log("SUCCESS", "A delayed transaction was completed"); |
Log("SUCCESS", "A delayed transaction was completed"); |
LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); |
LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest()); |
unlink $Transaction->getFile(); |
unlink($Transaction->getFile()); |
} |
} |
} |
} |
|
|
Line 1161 sub QueueDelayed {
|
Line 1168 sub QueueDelayed {
|
Debug(4, "Delayed path: ".$path); |
Debug(4, "Delayed path: ".$path); |
opendir(DIRHANDLE, $path); |
opendir(DIRHANDLE, $path); |
|
|
use Apache::lonnet; |
my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@all_host_ids)).')'; |
my @all_host_ids = &Apache::lonnet::machine_ids($RemoteHost); |
|
|
|
my $host_id_re = '(?:'.join('|',@all_host_ids).')'; |
|
my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE)); |
my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE)); |
closedir(DIRHANDLE); |
closedir(DIRHANDLE); |
foreach my $dfname (sort(@alldelayed)) { |
foreach my $dfname (sort(@alldelayed)) { |
Line 1208 sub MakeLondConnection {
|
Line 1212 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 1243 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 1379 sub ClientRequest {
|
Line 1383 sub ClientRequest {
|
$data = $data.$thisread; # Append new data. |
$data = $data.$thisread; # Append new data. |
$watcher->data($data); |
$watcher->data($data); |
if($data =~ /\n$/) { # Request entirely read. |
if($data =~ /\n$/) { # Request entirely read. |
if($data eq "close_connection_exit\n") { |
if ($data eq "close_connection_exit\n") { |
Log("CRITICAL", |
Log("CRITICAL", |
"Request Close Connection ... exiting"); |
"Request Close Connection ... exiting"); |
CloseAllLondConnections(); |
CloseAllLondConnections(); |
exit; |
exit; |
|
} elsif ($data eq "reset_retries\n") { |
|
Log("INFO", "Resetting Connection Retries."); |
|
$ConnectionRetriesLeft = $ConnectionRetries; |
|
&UpdateStatus(); |
|
my $Transaction = LondTransaction->new($data); |
|
$Transaction->SetClient($socket); |
|
StartClientReply($Transaction, "ok\n"); |
|
$watcher->cancel(); |
|
return; |
} |
} |
Debug(8, "Complete transaction received: ".$data); |
Debug(8, "Complete transaction received: ".$data); |
if($LogTransactions) { |
if ($LogTransactions) { |
Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n. |
Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n. |
} |
} |
my $Transaction = LondTransaction->new($data); |
my $Transaction = LondTransaction->new($data); |
Line 1764 sub CreateChild {
|
Line 1777 sub CreateChild {
|
my $pid = fork; |
my $pid = fork; |
if($pid) { # Parent |
if($pid) { # Parent |
$RemoteHost = "Parent"; |
$RemoteHost = "Parent"; |
$ChildHash{$pid} = $host; |
$ChildPid{$pid} = $host; |
sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
|
undef(@all_host_ids); |
} else { # child. |
} else { # child. |
$RemoteHostId = $hostid; |
$RemoteHostId = $hostid; |
ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
Line 1809 sub parent_client_connection {
|
Line 1822 sub parent_client_connection {
|
} |
} |
|
|
sub get_remote_hostname { |
sub get_remote_hostname { |
my ($event) = @_; |
my ($event) = @_; |
my $watcher = $event->w; |
my $watcher = $event->w; |
my $socket = $watcher->fd; |
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; |
my $thisread; |
$watcher->data($data); |
my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0); |
if($data =~ /\n$/) { # Request entirely read. |
Debug(8, "rcv: data length = ".length($thisread)." read =".$thisread); |
chomp($data); |
if (!defined($rv) || length($thisread) == 0) { |
} else { |
# Likely eof on socket. |
return; |
Debug(5,"Client Socket closed on lonc for p_c_c"); |
} |
close($socket); |
|
$watcher->cancel(); |
&Debug(5,"Creating child for $data (parent_client_connection)"); |
return; |
my ($hostname,$lonid) = split(':',$data,2); |
} |
|
|
|
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); |
&CreateChild($hostname,$lonid); |
|
} else { |
# Clean up the listen since now the child takes over until it exits. |
&Log('WARNING',"Request for a second child on $hostname"); |
$watcher->cancel(); # Nolonger listening to this event |
} |
$socket->send("done\n"); |
# Clean up the listen since now the child takes over until it exits. |
$socket->close(); |
$watcher->cancel(); # Nolonger listening to this event |
|
$socket->send("done\n"); |
|
$socket->close(); |
} |
} |
|
|
# parent_listen: |
# parent_listen: |
Line 1890 sub parent_listen {
|
Line 1907 sub parent_listen {
|
|
|
sub parent_clean_up { |
sub parent_clean_up { |
my ($loncapa_host) = @_; |
my ($loncapa_host) = @_; |
Debug(5, "parent_clean_up: $loncapa_host"); |
Debug(1, "parent_clean_up: $loncapa_host"); |
|
|
my $socket_file = &GetLoncSocketPath($loncapa_host); |
my $socket_file = &GetLoncSocketPath($loncapa_host); |
unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.] |
unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.] |
Line 1899 sub parent_clean_up {
|
Line 1916 sub parent_clean_up {
|
} |
} |
|
|
|
|
# listen_on_all_unix_sockets: |
|
# This sub initiates a listen on all unix domain lonc client sockets. |
# This sub initiates a listen on the common unix domain lonc client socket. |
# This will be called in the case where we are trimming idle processes. |
# loncnew starts up with no children, and only spawns off children when a |
# When idle processes are trimmed, loncnew starts up with no children, |
# connection request occurs on the common client unix socket. The spawned |
# and only spawns off children when a connection request occurs on the |
# child continues to run until it has been idle a while at which point it |
# client unix socket. The spawned child continues to run until it has |
# eventually exits and once more the parent picks up the listen. |
# been idle a while at which point it eventually exits and once more |
|
# the parent picks up the listen. |
|
# |
# |
# Parameters: |
# Parameters: |
# NONE |
# NONE |
Line 1915 sub parent_clean_up {
|
Line 1930 sub parent_clean_up {
|
# Returns: |
# Returns: |
# NONE |
# NONE |
# |
# |
sub listen_on_all_unix_sockets { |
|
Debug(5, "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->[3]; |
|
Debug(9, "Listen for $host_name"); |
|
&parent_listen($host_name); |
|
$host_iterator->next(); |
|
} |
|
} |
|
|
|
sub listen_on_common_socket { |
sub listen_on_common_socket { |
Debug(5, "listen_on_common_socket"); |
Debug(5, "listen_on_common_socket"); |
&parent_listen(); |
&parent_listen(); |
Line 1951 sub server_died {
|
Line 1954 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($ChildHost{$host}); |
&parent_clean_up($host); |
&parent_clean_up($host); |
|
|
} else { |
} else { |
Line 2078 sub CheckKids {
|
Line 2082 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 2155 SIGHUP. Responds to sigint and sigterm.
|
Line 2159 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 2173 sub really_kill_them_all_dammit
|
Line 2183 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"); |
} |
} |