version 1.4, 2003/04/24 10:56:55
|
version 1.5, 2003/04/29 03:24:51
|
Line 155 sub SocketDump {
|
Line 155 sub SocketDump {
|
|
|
=pod |
=pod |
|
|
|
=head2 ShowStatus |
|
|
|
Place some text as our pid status. |
|
|
|
=cut |
|
sub ShowStatus { |
|
my $status = shift; |
|
$0 = "lonc: ".$status; |
|
} |
|
|
|
=pod |
|
|
=head2 Tick |
=head2 Tick |
|
|
Invoked each timer tick. |
Invoked each timer tick. |
|
|
=cut |
=cut |
|
|
|
|
sub Tick { |
sub Tick { |
my $client; |
my $client; |
$0 = 'lonc: '.GetServerHost()." Connection count: ".$ConnectionCount; |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); |
Debug(6, "Tick"); |
Debug(6, "Tick"); |
Debug(6, " Current connection count: ".$ConnectionCount); |
Debug(6, " Current connection count: ".$ConnectionCount); |
foreach $client (keys %ActiveClients) { |
foreach $client (keys %ActiveClients) { |
Line 182 sub Tick {
|
Line 195 sub Tick {
|
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
} |
} |
|
|
|
# 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. |
|
# |
|
|
|
my $Requests = $WorkQueue->Count(); |
|
if (($ConnectionCount == 0) && ($Requests > 0)) { |
|
my $Connections = ($Requests <= $MaxConnectionCount) ? |
|
$Requests : $MaxConnectionCount; |
|
Debug(1,"Work but no connections, starting ".$Connections." of them"); |
|
for ($i =0; $i < $Connections; $i++) { |
|
MakeLondConnection(); |
|
} |
|
|
|
} |
} |
} |
|
|
=pod |
=pod |
Line 654 sub LondWritable {
|
Line 682 sub LondWritable {
|
if ($Socket->Writable() != 0) { |
if ($Socket->Writable() != 0) { |
# The write resulted in an error. |
# The write resulted in an error. |
# We'll treat this as if the socket got disconnected: |
# We'll treat this as if the socket got disconnected: |
if(exists($ActiveTransactions{$Socket})) { |
|
Debug(3, "Lond connection lost, failing transactions"); |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket, 1); |
KillSocket($Socket, 1); |
return; |
return; |
Line 679 sub LondWritable {
|
Line 704 sub LondWritable {
|
# we're waiting for the state to change |
# we're waiting for the state to change |
|
|
if($Socket->Writable() != 0) { |
if($Socket->Writable() != 0) { |
# Write of the next chunk resulted in an error. |
|
|
$Watcher->cancel(); |
|
KillSocket($Socket, 1); |
|
return; |
} |
} |
|
|
} elsif ($State eq "ChallengeReplied") { |
} elsif ($State eq "ChallengeReplied") { |
Line 697 sub LondWritable {
|
Line 725 sub LondWritable {
|
|
|
if($Socket->Writable() != 0) { |
if($Socket->Writable() != 0) { |
# Write resulted in an error. |
# Write resulted in an error. |
} |
|
|
|
|
$Watcher->cancel(); |
|
KillSocket($Socket, 1); |
|
return; |
|
|
|
} |
} elsif ($State eq "ReceivingKey") { |
} elsif ($State eq "ReceivingKey") { |
# Now we need to wait for the key |
# Now we need to wait for the key |
# to come back from the peer: |
# to come back from the peer: |
Line 711 sub LondWritable {
|
Line 743 sub LondWritable {
|
# peer... write the next chunk: |
# peer... write the next chunk: |
|
|
if($Socket->Writable() != 0) { |
if($Socket->Writable() != 0) { |
# Write resulted in an error. |
|
|
|
|
if(exists($ActiveTransactions{$Socket})) { |
|
Debug(3, "Lond connection lost, failing transactions"); |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket, 1); |
|
return; |
|
|
} |
} |
|
|
} elsif ($State eq "ReceivingReply") { |
} elsif ($State eq "ReceivingReply") { |
Line 753 sub MakeLondConnection {
|
Line 792 sub MakeLondConnection {
|
&GetServerPort()); |
&GetServerPort()); |
|
|
if($Connection == undef) { # Needs to be more robust later. |
if($Connection == undef) { # Needs to be more robust later. |
die "Failed to make a connection!!".$!."\n"; |
Debug(0,"Failed to make a connection with lond."); |
|
} else { |
|
# The connection needs to have writability |
|
# monitored in order to send the init sequence |
|
# that starts the whole authentication/key |
|
# exchange underway. |
|
# |
|
my $Socket = $Connection->GetSocket(); |
|
if($Socket == undef) { |
|
die "did not get a socket from the connection"; |
|
} else { |
|
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
|
} |
|
|
} |
|
# The connection needs to have writability |
$event = Event->io(fd => $Socket, |
# monitored in order to send the init sequence |
poll => 'w', |
# that starts the whole authentication/key |
cb => \&LondWritable, |
# exchange underway. |
data => ($Connection, undef), |
# |
desc => 'Connection to lond server'); |
my $Socket = $Connection->GetSocket(); |
$ActiveConnections{$Connection} = $event; |
if($Socket == undef) { |
|
die "did not get a socket from the connection"; |
$ConnectionCount++; |
} else { |
|
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
|
} |
} |
|
|
|
|
$event = Event->io(fd => $Socket, |
|
poll => 'w', |
|
cb => \&LondWritable, |
|
data => ($Connection, undef), |
|
desc => 'Connection to lond server'); |
|
$ActiveConnections{$Connection} = $event; |
|
|
|
$ConnectionCount++; |
|
|
|
|
|
} |
} |
|
|
Line 1043 sub ChildProcess {
|
Line 1081 sub ChildProcess {
|
# Setup the initial server connection: |
# Setup the initial server connection: |
|
|
&MakeLondConnection(); |
&MakeLondConnection(); |
|
|
|
if($ConnectionCount == 0) { |
|
Debug(1,"Could not make initial connection..\n"); |
|
Debug(1,"Will retry when there's work to do\n"); |
|
} |
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 1062 sub CreateChild {
|
Line 1104 sub CreateChild {
|
if($pid) { # Parent |
if($pid) { # Parent |
$ChildHash{$pid} = $RemoteHost; |
$ChildHash{$pid} = $RemoteHost; |
} else { # child. |
} else { # child. |
|
ShowStatus("Connected to ".$RemoteHost); |
ChildProcess; |
ChildProcess; |
} |
} |
|
|
Line 1076 sub CreateChild {
|
Line 1119 sub CreateChild {
|
# Each exit gets logged and the child gets restarted. |
# Each exit gets logged and the child gets restarted. |
# |
# |
|
|
|
# |
|
# Fork and start in new session so hang-up isn't going to |
|
# happen without intent. |
|
# |
|
|
|
|
|
ShowStatus("Parent writing pid file:"); |
|
$execdir = $perlvar{'lonDaemons'}; |
|
open (PIDSAVE, ">$execdir/logs/lonc.pid"); |
|
print PIDSAVE "$$\n"; |
|
close(PIDSAVE); |
|
|
|
ShowStatus("Forking node servers"); |
|
|
my $HostIterator = LondConnection::GetHostIterator; |
my $HostIterator = LondConnection::GetHostIterator; |
while (! $HostIterator->end()) { |
while (! $HostIterator->end()) { |
|
|
Line 1086 while (! $HostIterator->end()) {
|
Line 1143 while (! $HostIterator->end()) {
|
|
|
# Maintain the population: |
# Maintain the population: |
|
|
|
ShowStatus("Parent keeping the flock"); |
|
|
while(1) { |
while(1) { |
$deadchild = wait(); |
$deadchild = wait(); |
if(exists $ChildHash{$deadchild}) { # need to restart. |
if(exists $ChildHash{$deadchild}) { # need to restart. |