version 1.14, 2003/07/03 02:10:18
|
version 1.16, 2003/07/29 02:33:05
|
Line 27
|
Line 27
|
# 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 46
|
|
|
# Change log: |
# Change log: |
# $Log$ |
# $Log$ |
|
# 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 |
# Revision 1.14 2003/07/03 02:10:18 foxr |
# Get all of the signals to work correctly. |
# Get all of the signals to work correctly. |
# |
# |
Line 120 my $MaxConnectionCount = 10; # Will get
|
Line 129 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. |
|
|
# |
# |
Line 256 sub Debug {
|
Line 266 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 = $RemotHost"); |
} |
} |
} |
} |
|
|
Line 286 sub ShowStatus {
|
Line 296 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); |
|
} |
|
|
|
=pod |
|
|
=head2 Tick |
=head2 Tick |
|
|
Invoked each timer tick. |
Invoked each timer tick. |
Line 310 sub Tick {
|
Line 335 sub Tick {
|
} 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 $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 448 sub ClientWritable {
|
Line 479 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 1336 sub SignalledToDeath {
|
Line 1373 sub SignalledToDeath {
|
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 1348 sub ChildProcess {
|
Line 1401 sub ChildProcess {
|
# |
# |
# Signals must be handled by the Event framework... |
# Signals must be handled by the Event framework... |
# |
# |
# $SIG{QUIT} = \&SignalledToDeath; |
|
# $SIG{HUP} = \&ChildStatus; |
|
# $SIG{USR1} = IGNORE; |
|
# $SIG{INT} = DEFAULT; |
|
# $SIG{CHLD} = IGNORE; |
|
# $SIG{__DIE__} = \&SignalledToDeath; |
|
|
|
Event->signal(signal => "QUIT", |
Event->signal(signal => "QUIT", |
cb => \&SignalledToDeath, |
cb => \&SignalledToDeath, |
Line 1364 sub ChildProcess {
|
Line 1411 sub ChildProcess {
|
Event->signal(signal => "USR1", |
Event->signal(signal => "USR1", |
cb => \&ChildStatus, |
cb => \&ChildStatus, |
data => "USR1"); |
data => "USR1"); |
|
Event->signal(signal => "INT", |
|
cb => \&ToggleDebug, |
|
data => "INT"); |
|
|
SetupTimer(); |
SetupTimer(); |
|
|