loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.12 and 1.23

version 1.12, 2003/07/02 01:12:35	version 1.23, 2003/09/15 09:24:49
Line 7	Line 7
# Copyright Michigan State University Board of Trustees	# Copyright Michigan State University Board of Trustees
#	#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#	## LON-CAPA is free software; you can redistribute it and/or modify
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by	# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or	# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.	# (at your option) any later version.
Line 27	Line 26
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
#	#
# new lonc handles n requestors spread out bver m connections to londs.	# new lonc handles n request out bver m connections to londs.
# This module is based on the Event class.	# This module is based on the Event class.
# Development iterations:	# Development iterations:
# - Setup basic event loop. (done)	# - Setup basic event loop. (done)
Line 46	Line 45

# Change log:	# Change log:
# $Log$	# $Log$
# Revision 1.12 2003/07/02 01:12:35 foxr	# Revision 1.23 2003/09/15 09:24:49 foxr
# - Add some debugging to killthemall	# Add use strict and fix all the fallout from that.
# - Add better error handling to LondReadable	#
# - Remove tick logging in the timer handler.	# Revision 1.22 2003/09/02 10:34:47 foxr
	# - Fix errors in host dead detection logic (too many cases where the
	# retries left were not getting incremented or just not checked).
	# - Added some additional status to the ps axuww display:
	# o Remaining retries on a host.
	# o >>> DEAD <<< indicator if I've given up on a host.
	# - Tested the SIGHUP will reset the retries remaining count (thanks to
	# the above status stuff, and get allow the loncnew to re-try again
	# on the host (thanks to the log).
	#
	# Revision 1.21 2003/08/26 09:19:51 foxr
	# How embarrassing... put in the SocketTimeout function in loncnew and forgot
	# to actually hook it into the LondTransaction. Added this to MakeLondConnection
	# where it belongs... hopefully transactions (not just connection attempts) will
	# timeout more speedily than the socket errors will catch it.
	#
	# Revision 1.20 2003/08/25 18:48:11 albertel
	# - fixing a forgotten ;
	#
	# Revision 1.19 2003/08/19 09:31:46 foxr
	# Get socket directory from configuration rather than the old hard coded test
	# way that I forgot to un-hard code.
	#
	# Revision 1.18 2003/08/06 09:52:29 foxr
	# Also needed to remember to fail in-flight transactions if their sends fail.
	#
	# Revision 1.17 2003/08/03 00:44:31 foxr
	# 1. Correct handling of connection failure: Assume it means the host is
	# unreachable and fail all of the queued transactions. Note that the
	# inflight transactions should fail on their own time due either to timeout
	# or send/receive failures.
	# 2. Correct handling of logs for forced death signals. Pull the signal
	# from the event watcher.
	#
	# Revision 1.16 2003/07/29 02:33:05 foxr
	# Add SIGINT processing to child processes to toggle annoying trace mode
	# on/off.. will try to use this to isolate the compute boud process issue.
	#
	# Revision 1.15 2003/07/15 02:07:05 foxr
	# Added code for lonc/lond transaction timeouts. Who knows if it works right.
	# The intent is for a timeout to fail any transaction in progress and kill
	# off the sockt that timed out.
	#
	# Revision 1.14 2003/07/03 02:10:18 foxr
	# Get all of the signals to work correctly.
	#
	# Revision 1.13 2003/07/02 01:31:55 foxr
	# Added kill -HUP logic (restart).
#	#
# Revision 1.11 2003/06/25 01:54:44 foxr	# Revision 1.11 2003/06/25 01:54:44 foxr
# Fix more problems with transaction failure.	# Fix more problems with transaction failure.
Line 57	Line 103
# Revision 1.10 2003/06/24 02:46:04 foxr	# Revision 1.10 2003/06/24 02:46:04 foxr
# Put a limit on the number of times we'll retry a connection.	# Put a limit on the number of times we'll retry a connection.
# Start getting the signal stuff put in as well...note that need to get signals	# Start getting the signal stuff put in as well...note that need to get signals
# going or else 6the client will permanently give up on dead servers.	# going or else the client will permanently give up on dead servers.
#	#
# Revision 1.9 2003/06/13 02:38:43 foxr	# Revision 1.9 2003/06/13 02:38:43 foxr
# Add logging in 'expected format'	# Add logging in 'expected format'
Line 71	Line 117
# complete coding to support deferred transactions.	# complete coding to support deferred transactions.
#	#
#	#
	use strict;
use lib "/home/httpd/lib/perl/";	use lib "/home/httpd/lib/perl/";
use lib "/home/foxr/newloncapa/types";	use lib "/home/foxr/newloncapa/types";
use Event qw(:DEFAULT );	use Event qw(:DEFAULT );
Line 95 use LONCAPA::HashIterator;	Line 141 use LONCAPA::HashIterator;
#	#
# Disable all signals we might receive from outside for now.	# Disable all signals we might receive from outside for now.
#	#
$SIG{QUIT} = IGNORE;	#$SIG{QUIT} = IGNORE;
$SIG{HUP} = IGNORE;	#$SIG{HUP} = IGNORE;
$SIG{USR1} = IGNORE;	#$SIG{USR1} = IGNORE;
$SIG{INT} = IGNORE;	#$SIG{INT} = IGNORE;
$SIG{CHLD} = IGNORE;	#$SIG{CHLD} = IGNORE;
$SIG{__DIE__} = IGNORE;	#$SIG{__DIE__} = IGNORE;


# Read the httpd configuration file to get perl variables	# Read the httpd configuration file to get perl variables
Line 119 my $MaxConnectionCount = 10; # Will get	Line 165 my $MaxConnectionCount = 10; # Will get
my $ClientConnection = 0; # Uniquifier for client events.	my $ClientConnection = 0; # Uniquifier for client events.

my $DebugLevel = 0;	my $DebugLevel = 0;
	my $NextDebugLevel= 10; # So Sigint can toggle this.
my $IdleTimeout= 3600; # Wait an hour before pruning connections.	my $IdleTimeout= 3600; # Wait an hour before pruning connections.

#	#
# 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 $UnixSocketDir= "/home/httpd/sockets";	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.
my %ActiveTransactions; # LondTransactions in flight.	my %ActiveTransactions; # LondTransactions in flight.
Line 134 my $WorkQueue = Queue->new(); # Qu	Line 181 my $WorkQueue = Queue->new(); # Qu
my $ConnectionCount = 0;	my $ConnectionCount = 0;
my $IdleSeconds = 0; # Number of seconds idle.	my $IdleSeconds = 0; # Number of seconds idle.
my $Status = ""; # Current status string.	my $Status = ""; # Current status string.
	my $RecentLogEntry = "";
my $ConnectionRetries=5; # Number of connection retries allowed.	my $ConnectionRetries=5; # Number of connection retries allowed.
my $ConnectionRetriesLeft=5; # Number of connection retries remaining.	my $ConnectionRetriesLeft=5; # Number of connection retries remaining.

Line 210 sub Log {	Line 258 sub Log {
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
my $fh = IO::File->new(">>$execdir/logs/lonc.log");	my $fh = IO::File->new(">>$execdir/logs/lonc.log");
my $msg = sprintf($finalformat, $message);	my $msg = sprintf($finalformat, $message);
	$RecentLogEntry = $msg;
print $fh $msg;	print $fh $msg;


Line 232 sub GetPeername {	Line 281 sub GetPeername {
my $peerip;	my $peerip;
if($AdrFamily == AF_INET) {	if($AdrFamily == AF_INET) {
($peerport, $peerip) = sockaddr_in($peer);	($peerport, $peerip) = sockaddr_in($peer);
my $peername = gethostbyaddr($iaddr, $AdrFamily);	my $peername = gethostbyaddr($peerip, $AdrFamily);
return $peername;	return $peername;
} elsif ($AdrFamily == AF_UNIX) {	} elsif ($AdrFamily == AF_UNIX) {
my $peerfile;	my $peerfile;
Line 253 sub Debug {	Line 302 sub Debug {
my $level = shift;	my $level = shift;
my $message = shift;	my $message = shift;
if ($level <= $DebugLevel) {	if ($level <= $DebugLevel) {
print $message." host = ".$RemoteHost."\n";	Log("INFO", "-Debug- $message host = $RemoteHost");
}	}
}	}

Line 283 sub ShowStatus {	Line 332 sub ShowStatus {

=pod	=pod

	=head 2 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;

	KillSocket($Socket); # A transaction timeout also counts as
	# a connection failure:
	$ConnectionRetriesLeft--;
	}

	=pod

=head2 Tick	=head2 Tick

Invoked each timer tick.	Invoked each timer tick.
Line 292 Invoked each timer tick.	Line 358 Invoked each timer tick.

sub Tick {	sub Tick {
my $client;	my $client;
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);	if($ConnectionRetriesLeft > 0) {
	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
	." Retries remaining: ".$ConnectionRetriesLeft);
	} else {
	ShowStatus(GetServerHost()." >> DEAD <<");
	}
# Is it time to prune connection count:	# Is it time to prune connection count:


Line 301 sub Tick {	Line 371 sub Tick {
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?	($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
$IdleSeconds++;	$IdleSeconds++;
if($IdleSeconds > $IdleTimeout) { # Prune a connection...	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
$Socket = $IdleConnections->pop();	my $Socket = $IdleConnections->pop();
KillSocket($Socket);	KillSocket($Socket);
}	}
} else {	} else {
$IdleSeconds = 0; # Reset idle count if not idle.	$IdleSeconds = 0; # Reset idle count if not idle.
}	}
	#
	# For each inflight transaction, tick down its timeout counter.
	#
	foreach my $item (keys %ActiveTransactions) {
	my $Socket = $ActiveTransactions{$item}->getServer();
	$Socket->Tick();
	}
# Do we have work in the queue, but no connections to service them?	# Do we have work in the queue, but no connections to service them?
# If so, try to make some new connections to get things going again.	# If so, try to make some new connections to get things going again.
#	#
Line 318 sub Tick {	Line 394 sub Tick {
my $Connections = ($Requests <= $MaxConnectionCount) ?	my $Connections = ($Requests <= $MaxConnectionCount) ?
$Requests : $MaxConnectionCount;	$Requests : $MaxConnectionCount;
Debug(1,"Work but no connections, start ".$Connections." of them");	Debug(1,"Work but no connections, start ".$Connections." of them");
for ($i =0; $i < $Connections; $i++) {	my $successCount = 0;
MakeLondConnection();	for (my $i =0; $i < $Connections; $i++) {
	$successCount += MakeLondConnection();
	}
	if($successCount == 0) { # All connections failed:
	Debug(1,"Work in queue failed to make any connectiouns\n");
	EmptyQueue(); # Fail pending transactions with con_lost.
}	}
} else {	} else {
	ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
Debug(1,"Work in queue, but gave up on connections..flushing\n");	Debug(1,"Work in queue, but gave up on connections..flushing\n");
EmptyQueue(); # Connections can't be established.	EmptyQueue(); # Connections can't be established.
}	}
Line 373 sub ServerToIdle {	Line 455 sub ServerToIdle {

# If there's work to do, start the transaction:	# If there's work to do, start the transaction:

$reqdata = $WorkQueue->dequeue(); # This is a LondTransaction	my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
unless($reqdata eq undef) {	unless($reqdata eq undef) {
Debug(9, "Queue gave request data: ".$reqdata->getRequest());	Debug(9, "Queue gave request data: ".$reqdata->getRequest());
&StartRequest($Socket, $reqdata);	&StartRequest($Socket, $reqdata);
Line 445 sub ClientWritable {	Line 527 sub ClientWritable {

} else { # Partial string sent.	} else { # Partial string sent.
$Watcher->data(substr($Data, $result));	$Watcher->data(substr($Data, $result));
	if($result == 0) { # client hung up on us!!
	Log("INFO", "lonc pipe client hung up on us!");
	$Watcher->cancel;
	$Socket->shutdown(2);
	$Socket->close();
	}
}	}

} else { # Error of some sort...	} else { # Error of some sort...
Line 501 sub CompleteTransaction {	Line 589 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:$Client:".$Transaction->getRequest());	LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
unlink $Transaction->getFile();	unlink $Transaction->getFile();
}	}
}	}
Line 562 Parameters:	Line 650 Parameters:

sub FailTransaction {	sub FailTransaction {
my $transaction = shift;	my $transaction = shift;
	Log("WARNING", "Failing transaction ".$transaction->getRequest());
Debug(1, "Failing transaction: ".$transaction->getRequest());	Debug(1, "Failing transaction: ".$transaction->getRequest());
if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.	if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
my $client = $transaction->getClient();	my $client = $transaction->getClient();
Debug(1," Replying con_lost to ".$transaction->getRequest());	Debug(1," Replying con_lost to ".$transaction->getRequest());
StartClientReply($transaction, "con_lost\n");	StartClientReply($transaction, "con_lost\n");
}	}
	if($ConnectionRetriesLeft <= 0) {
	Log("CRITICAL", "Host marked dead: ".GetServerHost());
	}

}	}

Line 579 sub FailTransaction {	Line 671 sub FailTransaction {

=cut	=cut
sub EmptyQueue {	sub EmptyQueue {
	$ConnectionRetriesLeft--; # Counts as connection failure too.
while($WorkQueue->Count()) {	while($WorkQueue->Count()) {
my $request = $WorkQueue->dequeue(); # This is a transaction	my $request = $WorkQueue->dequeue(); # This is a transaction
FailTransaction($request);	FailTransaction($request);
Line 593 Close all connections open on lond prior	Line 686 Close all connections open on lond prior

=cut	=cut
sub CloseAllLondConnections {	sub CloseAllLondConnections {
foreach $Socket (keys %ActiveConnections) {	foreach my $Socket (keys %ActiveConnections) {
KillSocket($Socket);	KillSocket($Socket);
}	}
}	}
Line 624 nonzero if we are allowed to create a ne	Line 717 nonzero if we are allowed to create a ne
sub KillSocket {	sub KillSocket {
my $Socket = shift;	my $Socket = shift;

	Log("WARNING", "Shutting down a socket");
$Socket->Shutdown();	$Socket->Shutdown();

# If the socket came from the active connection set,	# If the socket came from the active connection set,
Line 644 sub KillSocket {	Line 738 sub KillSocket {
# work queue, the work all gets failed with con_lost.	# work queue, the work all gets failed with con_lost.
#	#
if($ConnectionCount == 0) {	if($ConnectionCount == 0) {
EmptyQueue;	EmptyQueue();
}	}
}	}

Line 713 sub LondReadable {	Line 807 sub LondReadable {
my $Socket = $Watcher->data;	my $Socket = $Watcher->data;
my $client = undef;	my $client = undef;

&Debug(6,"LondReadable called state = ".$State);	&Debug(6,"LondReadable called state = ".$Socket->GetState());


my $State = $Socket->GetState(); # All action depends on the state.	my $State = $Socket->GetState(); # All action depends on the state.

SocketDump(6, $Socket);	SocketDump(6, $Socket);
my $status = $Socket->Readable();	my $status = $Socket->Readable();

&Debug(2, "Socket->Readable returned: $status");	&Debug(2, "Socket->Readable returned: $status");

if($status != 0) {	if($status != 0) {
# bad return from socket read. Currently this means that	# bad return from socket read. Currently this means that
# The socket has become disconnected. We fail the transaction.	# The socket has become disconnected. We fail the transaction.

	Log("WARNING",
	"Lond connection lost.");
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
Debug(3,"Lond connection lost failing transaction");
FailTransaction($ActiveTransactions{$Socket});	FailTransaction($ActiveTransactions{$Socket});
}	}
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket);	KillSocket($Socket);
	$ConnectionRetriesLeft--; # Counts as connection failure
return;	return;
}	}
SocketDump(6,$Socket);	SocketDump(6,$Socket);
Line 765 sub LondReadable {	Line 862 sub LondReadable {
} elsif ($State eq "Idle") {	} elsif ($State eq "Idle") {
# If necessary, complete a transaction and then go into the	# If necessary, complete a transaction and then go into the
# idle queue.	# idle queue.
	# Note that a trasition to idle indicates a live lond
	# on the other end so reset the connection retries.
	#
	$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
$Watcher->cancel();	$Watcher->cancel();
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
Debug(8,"Completing transaction!!");	Debug(8,"Completing transaction!!");
Line 877 sub LondWritable {	Line 978 sub LondWritable {
# We'll treat this as if the socket got disconnected:	# We'll treat this as if the socket got disconnected:
Log("WARNING", "Connection to ".$RemoteHost.	Log("WARNING", "Connection to ".$RemoteHost.
" has been disconnected");	" has been disconnected");
	FailTransaction($ActiveTransactions{$Socket});
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket);	KillSocket($Socket);
return;	return;
Line 976 sub QueueDelayed {	Line 1078 sub QueueDelayed {
Debug(4, "Delayed path: ".$path);	Debug(4, "Delayed path: ".$path);
opendir(DIRHANDLE, $path);	opendir(DIRHANDLE, $path);

@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;	my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
Debug(4, "Got ".$alldelayed." delayed files");
closedir(DIRHANDLE);	closedir(DIRHANDLE);
my $dfname;	my $dfname;
my $reqfile;	my $reqfile;
Line 1019 sub MakeLondConnection {	Line 1120 sub MakeLondConnection {
$ConnectionRetriesLeft--;	$ConnectionRetriesLeft--;
return 0; # Failure.	return 0; # Failure.
} else {	} else {
$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
# 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 1032 sub MakeLondConnection {	Line 1133 sub MakeLondConnection {
&Debug(9,"MakeLondConnection got socket: ".$Socket);	&Debug(9,"MakeLondConnection got socket: ".$Socket);
}	}

	$Connection->SetTimeoutCallback(\&SocketTimeout);
$event = Event->io(fd => $Socket,
	my $event = Event->io(fd => $Socket,
poll => 'w',	poll => 'w',
cb => \&LondWritable,	cb => \&LondWritable,
data => $Connection,	data => $Connection,
Line 1089 sub StartRequest {	Line 1191 sub StartRequest {
$ActiveTransactions{$Lond} = $Request;	$ActiveTransactions{$Lond} = $Request;

$Lond->InitiateTransaction($Request->getRequest());	$Lond->InitiateTransaction($Request->getRequest());
$event = Event->io(fd => $Socket,	my $event = Event->io(fd => $Socket,
poll => "w",	poll => "w",
cb => \&LondWritable,	cb => \&LondWritable,
data => $Lond,	data => $Lond,
Line 1131 sub QueueTransaction {	Line 1233 sub QueueTransaction {
Debug(8,"Must queue...");	Debug(8,"Must queue...");
$WorkQueue->enqueue($requestData);	$WorkQueue->enqueue($requestData);
if($ConnectionCount < $MaxConnectionCount) {	if($ConnectionCount < $MaxConnectionCount) {
Debug(4,"Starting additional lond connection");	if($ConnectionRetriesLeft > 0) {
MakeLondConnection();	Debug(4,"Starting additional lond connection");
	if(MakeLondConnection() == 0) {
	EmptyQueue(); # Fail transactions, can't make connection.
	}
	} else {
	ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
	EmptyQueue(); # It's worse than that ... he's dead Jim.
	}
}	}
} else { # Can start the request:	} else { # Can start the request:
Debug(8,"Can start...");	Debug(8,"Can start...");
Line 1290 sub SetupLoncListener {	Line 1399 sub SetupLoncListener {
fd => $socket);	fd => $socket);
}	}

	=pod

	=head2 ChildStatus

	Child USR1 signal handler to report the most recent status
	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 {
	my $event = shift;
	my $watcher = $event->w;

	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".
	$RecentLogEntry."\n";
	$ConnectionRetriesLeft = $ConnectionRetries;
	}

=pod	=pod

=head2 SignalledToDeath	=head2 SignalledToDeath
Line 1300 Called in response to a signal that caus	Line 1431 Called in response to a signal that caus


sub SignalledToDeath {	sub SignalledToDeath {
Debug(2,"Signalled to death!");	my $event = shift;
my ($signal) = @_;	my $watcher= $event->w;

	Debug(2,"Signalled to death! via ".$watcher->data);
	my ($signal) = $watcher->data;
chomp($signal);	chomp($signal);
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "	Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
."died through "."\"$signal\"");	."died through "."\"$signal\"");
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "	LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
."\"$signal\"");	."\"$signal\"");
die("Signal abnormal end");
exit 0;	exit 0;

}	}

	=head2 ToggleDebug

	This sub toggles trace debugging on and off.

	=cut

	sub ToggleDebug {
	my $Current = $DebugLevel;
	$DebugLevel = $NextDebugLevel;
	$NextDebugLevel = $Current;

	Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");

	}

=head2 ChildProcess	=head2 ChildProcess

This sub implements a child process for a single lonc daemon.	This sub implements a child process for a single lonc daemon.
Line 1320 This sub implements a child process for	Line 1469 This sub implements a child process for
sub ChildProcess {	sub ChildProcess {


# For now turn off signals.	#
	# Signals must be handled by the Event framework...
$SIG{QUIT} = \&SignalledToDeath;	#
$SIG{HUP} = IGNORE;
$SIG{USR1} = IGNORE;	Event->signal(signal => "QUIT",
$SIG{INT} = DEFAULT;	cb => \&SignalledToDeath,
$SIG{CHLD} = IGNORE;	data => "QUIT");
$SIG{__DIE__} = \&SignalledToDeath;	Event->signal(signal => "HUP",
	cb => \&ChildStatus,
	data => "HUP");
	Event->signal(signal => "USR1",
	cb => \&ChildStatus,
	data => "USR1");
	Event->signal(signal => "INT",
	cb => \&ToggleDebug,
	data => "INT");

SetupTimer();	SetupTimer();

Line 1339 sub ChildProcess {	Line 1496 sub ChildProcess {

# Setup the initial server connection:	# Setup the initial server connection:

# &MakeLondConnection(); // let first work requirest do it.	# &MakeLondConnection(); // let first work requirest do it.


Debug(9,"Entering event loop");	Debug(9,"Entering event loop");
Line 1357 sub CreateChild {	Line 1514 sub CreateChild {
my $host = shift;	my $host = shift;
$RemoteHost = $host;	$RemoteHost = $host;
Log("CRITICAL", "Forking server for ".$host);	Log("CRITICAL", "Forking server for ".$host);
$pid = fork;	my $pid = fork;
if($pid) { # Parent	if($pid) { # Parent
	$RemoteHost = "Parent";
$ChildHash{$pid} = $RemoteHost;	$ChildHash{$pid} = $RemoteHost;
sigprocmask(SIG_UNBLOCK, $sigset);	sigprocmask(SIG_UNBLOCK, $sigset);

} else { # child.	} else { # child.
ShowStatus("Connected to ".$RemoteHost);	ShowStatus("Connected to ".$RemoteHost);
$SIG{INT} = DEFAULT;	$SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);	sigprocmask(SIG_UNBLOCK, $sigset);
ChildProcess; # Does not return.	ChildProcess; # Does not return.
}	}
Line 1401 if ($childpid != 0) {	Line 1559 if ($childpid != 0) {
#	#

ShowStatus("Parent writing pid file:");	ShowStatus("Parent writing pid file:");
$execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
open (PIDSAVE, ">$execdir/logs/lonc.pid");	open (PIDSAVE, ">$execdir/logs/lonc.pid");
print PIDSAVE "$$\n";	print PIDSAVE "$$\n";
close(PIDSAVE);	close(PIDSAVE);



if (POSIX::setsid() < 0) {	if (POSIX::setsid() < 0) {
print "Could not create new session\n";	print "Could not create new session\n";
exit -1;	exit -1;
Line 1418 Log("CRITICAL", "--------------- Startin	Line 1578 Log("CRITICAL", "--------------- Startin
my $HostIterator = LondConnection::GetHostIterator;	my $HostIterator = LondConnection::GetHostIterator;
while (! $HostIterator->end()) {	while (! $HostIterator->end()) {

$hostentryref = $HostIterator->get();	my $hostentryref = $HostIterator->get();
CreateChild($hostentryref->[0]);	CreateChild($hostentryref->[0]);
$HostIterator->next();	$HostIterator->next();
}	}
Line 1432 ShowStatus("Parent keeping the flock");	Line 1592 ShowStatus("Parent keeping the flock");
# Set up parent signals:	# Set up parent signals:
#	#

$SIG{INT} = \&KillThemAll;	$SIG{INT} = \&Terminate;
$SIG{TERM} = \&KillThemAll;	$SIG{TERM} = \&Terminate;
	$SIG{HUP} = \&Restart;
	$SIG{USR1} = \&CheckKids;

while(1) {	while(1) {
$deadchild = wait();	my $deadchild = wait();
if(exists $ChildHash{$deadchild}) { # need to restart.	if(exists $ChildHash{$deadchild}) { # need to restart.
$deadhost = $ChildHash{$deadchild};	my $deadhost = $ChildHash{$deadchild};
delete($ChildHash{$deadchild});	delete($ChildHash{$deadchild});
Log("WARNING","Lost child pid= ".$deadchild.	Log("WARNING","Lost child pid= ".$deadchild.
"Connected to host ".$deadhost);	"Connected to host ".$deadhost);
Line 1448 while(1) {	Line 1609 while(1) {
}	}
}	}



	=pod

	=head1 CheckKids

	Since kids do not die as easily in this implementation
	as the previous one, there is no need to restart the
	dead ones (all dead kids get restarted when they die!!)
	The only thing this function does is to pass USR1 to the
	kids so that they report their status.

	=cut

	sub CheckKids {
	Debug(2, "Checking status of children");
	my $docdir = $perlvar{'lonDocRoot'};
	my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
	my $now=time;
	my $local=localtime($now);
	print $fh "LONC status $local - parent $$ \n\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

	=head1 Restart

	Signal handler for HUP... all children are killed and
	we self restart. This is an el-cheapo way to re read
	the config file.

	=cut

	sub Restart {
	&KillThemAll; # First kill all the children.
	Log("CRITICAL", "Restarting");
	my $execdir = $perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");
	exec("$execdir/lonc");
	}

=pod	=pod

=head1 KillThemAll	=head1 KillThemAll

Signal handler that kills all children by sending them a	Signal handler that kills all children by sending them a
SIGINT. Responds to sigint and sigterm.	SIGHUP. Responds to sigint and sigterm.

=cut	=cut

sub KillThemAll {	sub KillThemAll {
Debug(2, "Kill them all!!");	Debug(2, "Kill them all!!");
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.	local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
foreach $pid (keys %ChildHash) {	foreach my $pid (keys %ChildHash) {
my $serving = $ChildHash{$pid};	my $serving = $ChildHash{$pid};
Debug(2, "Killing lonc for $serving pid = $pid");	Debug(2, "Killing lonc for $serving pid = $pid");
ShowStatus("Killing lonc for $serving pid = $pid");	ShowStatus("Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Killing lonc for $serving pid = $pid");	Log("CRITICAL", "Killing lonc for $serving pid = $pid");
kill('INT', $pid);	kill 'QUIT' => $pid;
	delete($ChildHash{$pid});
}	}
Log("CRITICAL", "Killing the master process.");	my $execdir = $perlvar{'lonDaemons'};
exit	unlink("$execdir/logs/lonc.pid");

}	}

=pod	=pod

	=head1 Terminate

	Terminate the system.

	=cut

	sub Terminate {
	KillThemAll;
	Log("CRITICAL","Master process exiting");
	exit 0;

	}
	=pod

=head1 Theory	=head1 Theory

The event class is used to build this as a single process with an	The event class is used to build this as a single process with an

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.12
changed lines
	Added in v.1.23