version 1.4, 2003/04/24 10:56:55
|
version 1.7, 2003/06/03 01:59:39
|
Line 34
|
Line 34
|
# - Add timer dispatch. (done) |
# - Add timer dispatch. (done) |
# - Add ability to accept lonc UNIX domain sockets. (done) |
# - Add ability to accept lonc UNIX domain sockets. (done) |
# - Add ability to create/negotiate lond connections (done). |
# - Add ability to create/negotiate lond connections (done). |
# - Add general logic for dispatching requests and timeouts. |
# - Add general logic for dispatching requests and timeouts. (done). |
# - Add support for the lonc/lond requests. |
# - Add support for the lonc/lond requests. (done). |
# - Add logging/status monitoring. |
# - Add logging/status monitoring. |
# - Add Signal handling - HUP restarts. USR1 status report. |
# - Add Signal handling - HUP restarts. USR1 status report. |
# - Add Configuration file I/O |
# - Add Configuration file I/O (done). |
# - Add Pending request processing on startup. |
# - Add Pending request processing on startup. |
# - Add management/status request interface. |
# - Add management/status request interface. |
|
# - Add deferred request capability. |
|
# |
|
|
|
# Change log: |
|
# $Log$ |
|
# Revision 1.7 2003/06/03 01:59:39 foxr |
|
# complete coding to support deferred transactions. |
|
# |
|
# |
|
|
use lib "/home/httpd/lib/perl/"; |
use lib "/home/httpd/lib/perl/"; |
use lib "/home/foxr/newloncapa/types"; |
use lib "/home/foxr/newloncapa/types"; |
Line 49 use POSIX qw(:signal_h);
|
Line 58 use POSIX qw(:signal_h);
|
use IO::Socket; |
use IO::Socket; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::UNIX; |
use IO::Socket::UNIX; |
|
use IO::Handle; |
use Socket; |
use Socket; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LONCAPA::Queue; |
use LONCAPA::Queue; |
use LONCAPA::Stack; |
use LONCAPA::Stack; |
use LONCAPA::LondConnection; |
use LONCAPA::LondConnection; |
|
use LONCAPA::LondTransaction; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
|
Line 95 my $RemoteHost; # Name of host child i
|
Line 106 my $RemoteHost; # Name of host child i
|
my $UnixSocketDir= "/home/httpd/sockets"; |
my $UnixSocketDir= "/home/httpd/sockets"; |
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; # Transactions in flight. |
my %ActiveTransactions; # LondTransactions in flight. |
my %ActiveClients; # Serial numbers of active clients by socket. |
my %ActiveClients; # Serial numbers of active clients by socket. |
my $WorkQueue = Queue->new(); # Queue of pending transactions. |
my $WorkQueue = Queue->new(); # Queue of pending transactions. |
my $ClientQueue = Queue->new(); # Queue of clients causing xactinos. |
# my $ClientQueue = Queue->new(); # Queue of clients causing xactinos. |
my $ConnectionCount = 0; |
my $ConnectionCount = 0; |
my $IdleSeconds = 0; # Number of seconds idle. |
my $IdleSeconds = 0; # Number of seconds idle. |
|
|
# |
# |
|
# This disconnected socket makes posible a bit more regular |
|
# code when processing delayed requests: |
|
# |
|
my $NullSocket = IO::Socket->new(); |
|
|
|
# |
|
|
=pod |
=pod |
|
|
Line 155 sub SocketDump {
|
Line 172 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 177 sub Tick {
|
Line 207 sub Tick {
|
$IdleSeconds++; |
$IdleSeconds++; |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
$Socket = $IdleConnections->pop(); |
$Socket = $IdleConnections->pop(); |
KillSocket($Socket, 0); |
KillSocket($Socket); |
} |
} |
} 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 222 long enough, it will be shut down and re
|
Line 267 long enough, it will be shut down and re
|
|
|
sub ServerToIdle { |
sub ServerToIdle { |
my $Socket = shift; # Get the socket. |
my $Socket = shift; # Get the socket. |
|
delete($ActiveTransactions{$Socket}); # Server has no transaction |
|
|
&Debug(6, "Server to idle"); |
&Debug(6, "Server to idle"); |
|
|
# If there's work to do, start the transaction: |
# If there's work to do, start the transaction: |
|
|
$reqdata = $WorkQueue->dequeue(); |
$reqdata = $WorkQueue->dequeue(); # This is a LondTransaction |
Debug(9, "Queue gave request data: ".$reqdata); |
|
unless($reqdata eq undef) { |
unless($reqdata eq undef) { |
my $unixSocket = $ClientQueue->dequeue(); |
Debug(9, "Queue gave request data: ".$reqdata->getRequest()); |
&Debug(6, "Starting new work request"); |
&StartRequest($Socket, $reqdata); |
&Debug(7, "Request: ".$reqdata); |
|
|
|
&StartRequest($Socket, $unixSocket, $reqdata); |
|
} else { |
} else { |
|
|
# There's no work waiting, so push the server to idle list. |
# There's no work waiting, so push the server to idle list. |
&Debug(8, "No new work requests, server connection going idle"); |
&Debug(8, "No new work requests, server connection going idle"); |
delete($ActiveTransactions{$Socket}); |
|
$IdleConnections->push($Socket); |
$IdleConnections->push($Socket); |
} |
} |
} |
} |
Line 274 sub ClientWritable {
|
Line 315 sub ClientWritable {
|
&Debug(6, "ClientWritable writing".$Data); |
&Debug(6, "ClientWritable writing".$Data); |
&Debug(9, "Socket is: ".$Socket); |
&Debug(9, "Socket is: ".$Socket); |
|
|
my $result = $Socket->send($Data, 0); |
if($Socket->connected) { |
|
my $result = $Socket->send($Data, 0); |
# $result undefined: the write failed. |
|
# otherwise $result is the number of bytes written. |
|
# Remove that preceding string from the data. |
|
# If the resulting data is empty, destroy the watcher |
|
# and set up a read event handler to accept the next |
|
# request. |
|
|
|
&Debug(9,"Send result is ".$result." Defined: ".defined($result)); |
|
if(defined($result)) { |
|
&Debug(9, "send result was defined"); |
|
if($result == length($Data)) { # Entire string sent. |
|
&Debug(9, "ClientWritable data all written"); |
|
$Watcher->cancel(); |
|
# |
|
# Set up to read next request from socket: |
|
|
|
my $descr = sprintf("Connection to lonc client %d", |
|
$ActiveClients{$Socket}); |
|
Event->io(cb => \&ClientRequest, |
|
poll => 'r', |
|
desc => $descr, |
|
data => "", |
|
fd => $Socket); |
|
|
|
} else { # Partial string sent. |
|
$Watcher->data(substr($Data, $result)); |
|
} |
|
|
|
} else { # Error of some sort... |
# $result undefined: the write failed. |
|
# otherwise $result is the number of bytes written. |
# Some errnos are possible: |
# Remove that preceding string from the data. |
my $errno = $!; |
# If the resulting data is empty, destroy the watcher |
if($errno == POSIX::EWOULDBLOCK || |
# and set up a read event handler to accept the next |
$errno == POSIX::EAGAIN || |
# request. |
$errno == POSIX::EINTR) { |
|
# No action taken? |
|
} else { # Unanticipated errno. |
|
&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); |
|
$Watcher->cancel; # Stop the watcher. |
|
$Socket->shutdown(2); # Kill connection |
|
$Socket->close(); # Close the socket. |
|
} |
|
|
|
|
&Debug(9,"Send result is ".$result." Defined: ".defined($result)); |
|
if(defined($result)) { |
|
&Debug(9, "send result was defined"); |
|
if($result == length($Data)) { # Entire string sent. |
|
&Debug(9, "ClientWritable data all written"); |
|
$Watcher->cancel(); |
|
# |
|
# Set up to read next request from socket: |
|
|
|
my $descr = sprintf("Connection to lonc client %d", |
|
$ActiveClients{$Socket}); |
|
Event->io(cb => \&ClientRequest, |
|
poll => 'r', |
|
desc => $descr, |
|
data => "", |
|
fd => $Socket); |
|
|
|
} else { # Partial string sent. |
|
$Watcher->data(substr($Data, $result)); |
|
} |
|
|
|
} else { # Error of some sort... |
|
|
|
# Some errnos are possible: |
|
my $errno = $!; |
|
if($errno == POSIX::EWOULDBLOCK || |
|
$errno == POSIX::EAGAIN || |
|
$errno == POSIX::EINTR) { |
|
# No action taken? |
|
} else { # Unanticipated errno. |
|
&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); |
|
$Watcher->cancel; # Stop the watcher. |
|
$Socket->shutdown(2); # Kill connection |
|
$Socket->close(); # Close the socket. |
|
} |
|
|
|
} |
|
} else { |
|
$Watcher->cancel(); # A delayed request...just cancel. |
} |
} |
} |
} |
|
|
Line 339 Parameters:
|
Line 384 Parameters:
|
Socket on which the lond transaction occured. This is a |
Socket on which the lond transaction occured. This is a |
LondConnection. The data received is in the TransactionReply member. |
LondConnection. The data received is in the TransactionReply member. |
|
|
=item Client |
=item Transaction |
|
|
Unix domain socket open on the ultimate client. |
The transaction that is being completed. |
|
|
=cut |
=cut |
|
|
sub CompleteTransaction { |
sub CompleteTransaction { |
&Debug(6,"Complete transaction"); |
&Debug(6,"Complete transaction"); |
my $Socket = shift; |
my $Socket = shift; |
my $Client = shift; |
my $Transaction = shift; |
|
|
|
if (!$Transaction->isDeferred()) { # Normal transaction |
|
my $data = $Socket->GetReply(); # Data to send. |
|
StartClientReply($Transaction, $data); |
|
} else { # Delete deferred transaction file. |
|
unlink $Transaction->getFile(); |
|
} |
|
} |
|
=pod |
|
=head1 StartClientReply |
|
|
|
Initiates a reply to a client where the reply data is a parameter. |
|
|
|
=head2 parameters: |
|
|
|
=item Transaction |
|
|
|
The transaction for which we are responding to the client. |
|
|
|
=item data |
|
|
my $data = $Socket->GetReply(); # Data to send. |
The data to send to apached client. |
|
|
|
=cut |
|
sub StartClientReply { |
|
my $Transaction = shift; |
|
my $data = shift; |
|
|
|
my $Client = $Transaction->getClient(); |
|
|
&Debug(8," Reply was: ".$data); |
&Debug(8," Reply was: ".$data); |
my $Serial = $ActiveClients{$Client}; |
my $Serial = $ActiveClients{$Client}; |
my $desc = sprintf("Connection to lonc client %d", |
my $desc = sprintf("Connection to lonc client %d", |
|
|
$Serial); |
$Serial); |
Event->io(fd => $Client, |
Event->io(fd => $Client, |
poll => "w", |
poll => "w", |
Line 366 sub CompleteTransaction {
|
Line 439 sub CompleteTransaction {
|
=head2 FailTransaction |
=head2 FailTransaction |
|
|
Finishes a transaction with failure because the associated lond socket |
Finishes a transaction with failure because the associated lond socket |
disconnected. It is up to our client to retry if desired. |
disconnected. There are two possibilities: |
|
- The transaction is deferred: in which case we just quietly |
|
delete the transaction since there is no client connection. |
|
- The transaction is 'live' in which case we initiate the sending |
|
of "con_lost" to the client. |
|
|
|
Deleting the transaction means killing it from the |
|
%ActiveTransactions hash. |
|
|
Parameters: |
Parameters: |
|
|
=item client |
=item client |
|
|
The UNIX domain socket open on our client. |
The LondTransaction we are failing. |
|
|
=cut |
=cut |
|
|
sub FailTransaction { |
sub FailTransaction { |
my $client = shift; |
my $transaction = shift; |
|
my $Lond = $transaction->getServer(); |
|
if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it. |
|
my $client = $transcation->getClient(); |
|
StartClientReply($client, "con_lost"); |
|
} |
|
# not needed, done elsewhere if active. |
|
# delete $ActiveTransactions{$Lond}; |
|
|
|
} |
|
|
&Debug(8, "Failing transaction due to disconnect"); |
=pod |
my $Serial = $ActiveClients{$client}; |
=head1 EmptyQueue |
my $desc = sprintf("Connection to lonc client %d", $Serial); |
|
my $data = "error: Connection to lond lost\n"; |
|
|
|
Event->io(fd => $client, |
|
poll => "w", |
|
desc => $desc, |
|
cb => \&ClientWritable, |
|
data => $data); |
|
|
|
|
Fails all items in the work queue with con_lost. |
|
Note that each item in the work queue is a transaction. |
|
|
|
=cut |
|
sub EmptyQueue { |
|
while($WorkQueue->Count()) { |
|
my $request = $Workqueue->dequeue(); # This is a transaction |
|
FailTransaction($request); |
|
} |
} |
} |
|
|
=pod |
=pod |
Line 416 nonzero if we are allowed to create a ne
|
Line 506 nonzero if we are allowed to create a ne
|
=cut |
=cut |
sub KillSocket { |
sub KillSocket { |
my $Socket = shift; |
my $Socket = shift; |
my $Restart= shift; |
|
|
|
# If the socket came from the active connection set, delete it. |
# If the socket came from the active connection set, |
# otherwise it came from the idle set and has already been destroyed: |
# delete its transaction... note that FailTransaction should |
|
# already have been called!!! |
|
# otherwise it came from the idle set. |
|
# |
|
|
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
delete ($ActiveTransactions{$Socket}); |
delete ($ActiveTransactions{$Socket}); |
Line 428 sub KillSocket {
|
Line 520 sub KillSocket {
|
delete($ActiveConnections{$Socket}); |
delete($ActiveConnections{$Socket}); |
} |
} |
$ConnectionCount--; |
$ConnectionCount--; |
if( ($ConnectionCount = 0) && ($Restart)) { |
|
MakeLondConnection(); |
|
} |
|
|
|
|
# If the connection count has gone to zero and there is work in the |
|
# work queue, the work all gets failed with con_lost. |
|
# |
|
if($ConnectionCount == 0) { |
|
EmptyQueue; |
|
} |
} |
} |
|
|
=pod |
=pod |
Line 513 sub LondReadable {
|
Line 608 sub LondReadable {
|
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket, 1); |
KillSocket($Socket); |
return; |
return; |
} |
} |
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
Line 554 sub LondReadable {
|
Line 649 sub LondReadable {
|
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
ServerToIdle($Socket); # Next work unit or idle. |
ServerToIdle($Socket); # Next work unit or idle. |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
# We need to be writable for this and probably don't belong |
# We need to be writable for this and probably don't belong |
# here inthe first place. |
# here inthe first place. |
Line 639 sub LondWritable {
|
Line 734 sub LondWritable {
|
my @data = $Watcher->data; |
my @data = $Watcher->data; |
Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n"); |
Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n"); |
|
|
my $Socket = $data[0]; # I know there's at least a socket. |
my $Socket = $data; # I know there's at least a socket. |
|
|
# Figure out what to do depending on the state of the socket: |
# Figure out what to do depending on the state of the socket: |
|
|
Line 654 sub LondWritable {
|
Line 749 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); |
return; |
return; |
} |
} |
# "init" is being sent... |
# "init" is being sent... |
Line 679 sub LondWritable {
|
Line 771 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); |
|
return; |
} |
} |
|
|
} elsif ($State eq "ChallengeReplied") { |
} elsif ($State eq "ChallengeReplied") { |
Line 697 sub LondWritable {
|
Line 792 sub LondWritable {
|
|
|
if($Socket->Writable() != 0) { |
if($Socket->Writable() != 0) { |
# Write resulted in an error. |
# Write resulted in an error. |
} |
|
|
|
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
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 810 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); |
|
return; |
|
|
} |
} |
|
|
} elsif ($State eq "ReceivingReply") { |
} elsif ($State eq "ReceivingReply") { |
Line 732 sub LondWritable {
|
Line 838 sub LondWritable {
|
} |
} |
|
|
} |
} |
|
=pod |
|
|
|
=cut |
|
sub QueueDelayed { |
|
my $path = "$perlvar{'lonSockDir'}/delayed"; |
|
opendir(DIRHANDLE, $path); |
|
@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
|
closedir(DIRHANDLE); |
|
my $dfname; |
|
my $reqfile |
|
foreach $reqfile (sort @alldelayed) { |
|
$reqfile = $path/$reqfile; |
|
my $Handle = IO::File->new($reqfile); |
|
my $cmd = <$Handle>; |
|
chomp($cmd); |
|
my $Transaction = LondTransaction->new($cmd); |
|
$Transaction->SetDeferred($reqfile); |
|
QueueTransaction($Transaction); |
|
} |
|
|
|
} |
|
|
=pod |
=pod |
|
|
Line 753 sub MakeLondConnection {
|
Line 880 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, |
# |
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 { |
if($ConnectionCount == 1) { # First Connection: |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
QueueDelayed; |
|
} |
} |
} |
|
|
|
|
$event = Event->io(fd => $Socket, |
|
poll => 'w', |
|
cb => \&LondWritable, |
|
data => ($Connection, undef), |
|
desc => 'Connection to lond server'); |
|
$ActiveConnections{$Connection} = $event; |
|
|
|
$ConnectionCount++; |
|
|
|
|
|
} |
} |
|
|
Line 808 The text of the request to send.
|
Line 937 The text of the request to send.
|
|
|
sub StartRequest { |
sub StartRequest { |
my $Lond = shift; |
my $Lond = shift; |
my $Client = shift; |
my $Request = shift; # This is a LondTransaction. |
my $Request = shift; |
|
|
|
Debug(6, "StartRequest: ".$Request); |
Debug(6, "StartRequest: ".$Request->getRequest()); |
|
|
my $Socket = $Lond->GetSocket(); |
my $Socket = $Lond->GetSocket(); |
|
|
$ActiveTransactions{$Lond} = $Client; # Socket to relay to client. |
$Request->Activate($Lond); |
|
$ActiveTransactions{$Lond} = $Request; |
|
|
$Lond->InitiateTransaction($Request); |
$Lond->InitiateTransaction($Request->getRequest()); |
$event = Event->io(fd => $Lond->GetSocket(), |
$event = Event->io(fd => $Lond->GetSocket(), |
poll => "w", |
poll => "w", |
cb => \&LondWritable, |
cb => \&LondWritable, |
Line 849 data to send to the lond.
|
Line 978 data to send to the lond.
|
=cut |
=cut |
|
|
sub QueueTransaction { |
sub QueueTransaction { |
my $requestSocket = shift; |
|
my $requestData = shift; |
|
|
|
Debug(6,"QueueTransaction: ".$requestData); |
my $requestData = shift; # This is a LondTransaction. |
|
my $cmd = $requestData->getRequest(); |
|
|
|
Debug(6,"QueueTransaction: ".$cmd); |
|
|
my $LondSocket = $IdleConnections->pop(); |
my $LondSocket = $IdleConnections->pop(); |
if(!defined $LondSocket) { # Need to queue request. |
if(!defined $LondSocket) { # Need to queue request. |
Debug(8,"Must queue..."); |
Debug(8,"Must queue..."); |
$ClientQueue->enqueue($requestSocket); |
|
$WorkQueue->enqueue($requestData); |
$WorkQueue->enqueue($requestData); |
if($ConnectionCount < $MaxConnectionCount) { |
if($ConnectionCount < $MaxConnectionCount) { |
Debug(4,"Starting additional lond connection"); |
Debug(4,"Starting additional lond connection"); |
Line 865 sub QueueTransaction {
|
Line 994 sub QueueTransaction {
|
} |
} |
} else { # Can start the request: |
} else { # Can start the request: |
Debug(8,"Can start..."); |
Debug(8,"Can start..."); |
StartRequest($LondSocket, $requestSocket, $requestData); |
StartRequest($LondSocket, $requestData); |
} |
} |
} |
} |
|
|
Line 905 sub ClientRequest {
|
Line 1034 sub ClientRequest {
|
$watcher->data($data); |
$watcher->data($data); |
if($data =~ /(.*\n)/) { # Request entirely read. |
if($data =~ /(.*\n)/) { # Request entirely read. |
Debug(8, "Complete transaction received: ".$data); |
Debug(8, "Complete transaction received: ".$data); |
QueueTransaction($socket, $data); |
my $Transaction = new LondTransaction->new($data); |
|
$Transaction->SetClient($socket); |
|
QueueTransaction($Transaction); |
$watcher->cancel(); # Done looking for input data. |
$watcher->cancel(); # Done looking for input data. |
} |
} |
|
|
Line 967 Returns the host whose lond we talk with
|
Line 1098 Returns the host whose lond we talk with
|
|
|
=cut |
=cut |
|
|
sub GetServerHost { # Stub - get this from config. |
sub GetServerHost { |
return $RemoteHost; # Setup by the fork. |
return $RemoteHost; # Setup by the fork. |
} |
} |
|
|
Line 979 Returns the lond port number.
|
Line 1110 Returns the lond port number.
|
|
|
=cut |
=cut |
|
|
sub GetServerPort { # Stub - get this from config. |
sub GetServerPort { |
return $perlvar{londPort}; |
return $perlvar{londPort}; |
} |
} |
|
|
Line 1000 sub SetupLoncListener {
|
Line 1131 sub SetupLoncListener {
|
my $socket; |
my $socket; |
my $SocketName = GetLoncSocketPath(); |
my $SocketName = GetLoncSocketPath(); |
unlink($SocketName); |
unlink($SocketName); |
unless ($socket = IO::Socket::UNIX->new(Local => $SocketName, |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
Listen => 10, |
Listen => 10, |
Type => SOCK_STREAM)) { |
Type => SOCK_STREAM)) { |
die "Failed to create a lonc listner socket"; |
die "Failed to create a lonc listner socket"; |
Line 1043 sub ChildProcess {
|
Line 1174 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 1197 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 1212 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("Forming new session"); |
|
my $childpid = fork; |
|
if ($childpid != 0) { |
|
sleep 4; # Give child a chacne to break to |
|
exit 0; # a new sesion. |
|
} |
|
|
|
if (POSIX::setsid() < 0) { |
|
print "Could not create new session\n"; |
|
exit -1; |
|
} |
|
|
|
ShowStatus("Forking node servers"); |
|
|
my $HostIterator = LondConnection::GetHostIterator; |
my $HostIterator = LondConnection::GetHostIterator; |
while (! $HostIterator->end()) { |
while (! $HostIterator->end()) { |
|
|
Line 1086 while (! $HostIterator->end()) {
|
Line 1250 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. |