version 1.7, 2003/06/03 01:59:39
|
version 1.8, 2003/06/11 02:04:35
|
Line 39
|
Line 39
|
# - 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 (done). |
# - Add Configuration file I/O (done). |
# - Add Pending request processing on startup. |
|
# - Add management/status request interface. |
# - Add management/status request interface. |
# - Add deferred request capability. |
# - Add deferred request capability. (done) |
# |
# |
|
|
# Change log: |
# Change log: |
# $Log$ |
# $Log$ |
|
# Revision 1.8 2003/06/11 02:04:35 foxr |
|
# Support delayed transactions... this is done uniformly by encapsulating |
|
# transactions in an object ... a LondTransaction that is implemented by |
|
# LondTransaction.pm |
|
# |
# Revision 1.7 2003/06/03 01:59:39 foxr |
# Revision 1.7 2003/06/03 01:59:39 foxr |
# complete coding to support deferred transactions. |
# complete coding to support deferred transactions. |
# |
# |
Line 96 my %ChildHash; # by pid -> host.
|
Line 100 my %ChildHash; # by pid -> host.
|
my $MaxConnectionCount = 5; # Will get from config later. |
my $MaxConnectionCount = 5; # Will get from config later. |
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
my $DebugLevel = 5; |
my $DebugLevel = 2; |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
|
|
# |
# |
Line 277 sub ServerToIdle {
|
Line 281 sub ServerToIdle {
|
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); |
|
|
} 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. |
Line 399 sub CompleteTransaction {
|
Line 404 sub CompleteTransaction {
|
my $data = $Socket->GetReply(); # Data to send. |
my $data = $Socket->GetReply(); # Data to send. |
StartClientReply($Transaction, $data); |
StartClientReply($Transaction, $data); |
} else { # Delete deferred transaction file. |
} else { # Delete deferred transaction file. |
|
&Debug(4, "Deferred transaction complete: ".$Transaction->getFile(). |
|
" request: ".$Transaction->getRequest(). |
|
" answer: ".$Socket->GetReply()); |
unlink $Transaction->getFile(); |
unlink $Transaction->getFile(); |
} |
} |
} |
} |
Line 588 transaction is in progress, the socket a
|
Line 596 transaction is in progress, the socket a
|
=cut |
=cut |
|
|
sub LondReadable { |
sub LondReadable { |
|
|
my $Event = shift; |
my $Event = shift; |
my $Watcher = $Event->w; |
my $Watcher = $Event->w; |
my $Socket = $Watcher->data; |
my $Socket = $Watcher->data; |
my $client = undef; |
my $client = undef; |
|
|
|
&Debug(6,"LondReadable called state = ".$State); |
|
|
|
|
my $State = $Socket->GetState(); # All action depends on the state. |
my $State = $Socket->GetState(); # All action depends on the state. |
|
|
&Debug(6,"LondReadable called state = ".$State); |
|
SocketDump(6, $Socket); |
SocketDump(6, $Socket); |
|
|
if($Socket->Readable() != 0) { |
if($Socket->Readable() != 0) { |
Line 624 sub LondReadable {
|
Line 634 sub LondReadable {
|
# in the connection takes care of setting that up. Just |
# in the connection takes care of setting that up. Just |
# need to transition to writable: |
# need to transition to writable: |
|
|
$Watcher->poll("w"); |
|
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
|
$Watcher->poll("w"); |
|
|
} elsif ($State eq "ChallengeReplied") { |
} elsif ($State eq "ChallengeReplied") { |
|
|
Line 634 sub LondReadable {
|
Line 644 sub LondReadable {
|
# The ok was received. Now we need to request the key |
# The ok was received. Now we need to request the key |
# That requires us to be writable: |
# That requires us to be writable: |
|
|
$Watcher->poll("w"); |
|
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
|
$Watcher->poll("w"); |
|
|
} elsif ($State eq "ReceivingKey") { |
} elsif ($State eq "ReceivingKey") { |
|
|
} 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. |
|
$Watcher->cancel(); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Debug(8,"Completing transaction!!"); |
Debug(8,"Completing transaction!!"); |
CompleteTransaction($Socket, |
CompleteTransaction($Socket, |
$ActiveTransactions{$Socket}); |
$ActiveTransactions{$Socket}); |
} |
} |
$Watcher->cancel(); |
|
ServerToIdle($Socket); # Next work unit or idle. |
ServerToIdle($Socket); # Next work unit or idle. |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
Line 731 is the socket on which to return a reply
|
Line 741 is the socket on which to return a reply
|
sub LondWritable { |
sub LondWritable { |
my $Event = shift; |
my $Event = shift; |
my $Watcher = $Event->w; |
my $Watcher = $Event->w; |
my @data = $Watcher->data; |
my $Socket = $Watcher->data; |
Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n"); |
my $State = $Socket->GetState(); |
|
|
my $Socket = $data; # I know there's at least a socket. |
Debug(6,"LondWritable State = ".$State."\n"); |
|
|
|
|
# Figure out what to do depending on the state of the socket: |
# Figure out what to do depending on the state of the socket: |
|
|
|
|
my $State = $Socket->GetState(); |
|
|
|
|
|
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
Line 762 sub LondWritable {
|
Line 772 sub LondWritable {
|
# Now that init was sent, we switch |
# Now that init was sent, we switch |
# to watching for readability: |
# to watching for readability: |
|
|
$Watcher->poll("r"); |
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
} elsif ($State eq "ChallengeReceived") { |
} elsif ($State eq "ChallengeReceived") { |
# We received the challenge, now we |
# We received the challenge, now we |
Line 781 sub LondWritable {
|
Line 791 sub LondWritable {
|
# The echo was sent back, so we switch |
# The echo was sent back, so we switch |
# to watching readability. |
# to watching readability. |
|
|
$Watcher->poll("r"); |
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
} elsif ($State eq "RequestingKey") { |
} elsif ($State eq "RequestingKey") { |
# At this time we're requesting the key. |
# At this time we're requesting the key. |
Line 802 sub LondWritable {
|
Line 812 sub LondWritable {
|
# 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: |
|
|
$Watcher->poll("r"); |
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
# At this time we are sending a request to the |
# At this time we are sending a request to the |
Line 825 sub LondWritable {
|
Line 835 sub LondWritable {
|
# The send has completed. Wait for the |
# The send has completed. Wait for the |
# data to come in for a reply. |
# data to come in for a reply. |
Debug(8,"Writable sent request/receiving reply"); |
Debug(8,"Writable sent request/receiving reply"); |
$Watcher->poll("r"); |
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
} else { |
} else { |
# Control only passes here on an error: |
# Control only passes here on an error: |
Line 842 sub LondWritable {
|
Line 852 sub LondWritable {
|
|
|
=cut |
=cut |
sub QueueDelayed { |
sub QueueDelayed { |
|
Debug(3,"QueueDelayed called"); |
|
|
my $path = "$perlvar{'lonSockDir'}/delayed"; |
my $path = "$perlvar{'lonSockDir'}/delayed"; |
|
|
|
Debug(4, "Delayed path: ".$path); |
opendir(DIRHANDLE, $path); |
opendir(DIRHANDLE, $path); |
|
|
@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
|
Debug(4, "Got ".$alldelayed." delayed files"); |
closedir(DIRHANDLE); |
closedir(DIRHANDLE); |
my $dfname; |
my $dfname; |
my $reqfile |
my $reqfile; |
foreach $reqfile (sort @alldelayed) { |
foreach $dfname (sort @alldelayed) { |
$reqfile = $path/$reqfile; |
$reqfile = "$path/$dfname"; |
|
Debug(4, "queueing ".$reqfile); |
my $Handle = IO::File->new($reqfile); |
my $Handle = IO::File->new($reqfile); |
my $cmd = <$Handle>; |
my $cmd = <$Handle>; |
chomp($cmd); |
chomp $cmd; # There may or may not be a newline... |
|
$cmd = $cmd."\ny"; # now for sure there's exactly one newline. |
my $Transaction = LondTransaction->new($cmd); |
my $Transaction = LondTransaction->new($cmd); |
$Transaction->SetDeferred($reqfile); |
$Transaction->SetDeferred($reqfile); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
Line 898 sub MakeLondConnection {
|
Line 916 sub MakeLondConnection {
|
$event = Event->io(fd => $Socket, |
$event = Event->io(fd => $Socket, |
poll => 'w', |
poll => 'w', |
cb => \&LondWritable, |
cb => \&LondWritable, |
data => \$Connection, |
data => $Connection, |
desc => 'Connection to lond server'); |
desc => 'Connection to lond server'); |
$ActiveConnections{$Connection} = $event; |
$ActiveConnections{$Connection} = $event; |
|
|
$ConnectionCount++; |
$ConnectionCount++; |
|
Debug(4, "Connection count = ".$ConnectionCount); |
if($ConnectionCount == 1) { # First Connection: |
if($ConnectionCount == 1) { # First Connection: |
QueueDelayed; |
QueueDelayed; |
} |
} |
Line 947 sub StartRequest {
|
Line 966 sub StartRequest {
|
$ActiveTransactions{$Lond} = $Request; |
$ActiveTransactions{$Lond} = $Request; |
|
|
$Lond->InitiateTransaction($Request->getRequest()); |
$Lond->InitiateTransaction($Request->getRequest()); |
$event = Event->io(fd => $Lond->GetSocket(), |
$event = Event->io(fd => $Socket, |
poll => "w", |
poll => "w", |
cb => \&LondWritable, |
cb => \&LondWritable, |
data => $Lond, |
data => $Lond, |
Line 1034 sub ClientRequest {
|
Line 1053 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); |
my $Transaction = new LondTransaction->new($data); |
my $Transaction = LondTransaction->new($data); |
$Transaction->SetClient($socket); |
$Transaction->SetClient($socket); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
$watcher->cancel(); # Done looking for input data. |
$watcher->cancel(); # Done looking for input data. |
Line 1220 sub CreateChild {
|
Line 1239 sub CreateChild {
|
|
|
|
|
|
|
ShowStatus("Parent writing pid file:"); |
|
$execdir = $perlvar{'lonDaemons'}; |
|
open (PIDSAVE, ">$execdir/logs/lonc.pid"); |
|
print PIDSAVE "$$\n"; |
|
close(PIDSAVE); |
|
|
|
ShowStatus("Forming new session"); |
ShowStatus("Forming new session"); |
my $childpid = fork; |
my $childpid = fork; |
Line 1232 if ($childpid != 0) {
|
Line 1247 if ($childpid != 0) {
|
sleep 4; # Give child a chacne to break to |
sleep 4; # Give child a chacne to break to |
exit 0; # a new sesion. |
exit 0; # a new sesion. |
} |
} |
|
# |
|
# Write my pid into the pid file so I can be located |
|
# |
|
|
|
ShowStatus("Parent writing pid file:"); |
|
$execdir = $perlvar{'lonDaemons'}; |
|
open (PIDSAVE, ">$execdir/logs/lonc.pid"); |
|
print PIDSAVE "$$\n"; |
|
close(PIDSAVE); |
|
|
if (POSIX::setsid() < 0) { |
if (POSIX::setsid() < 0) { |
print "Could not create new session\n"; |
print "Could not create new session\n"; |