Date: Fri, 12 Sep 2003 10:23:21 -0400
To: [EMAIL PROTECTED]
From: Daniel Wilson <[EMAIL PROTECTED]>
Subject: Socket/Net Flushing Problem ???
Hello Everyone:
First: I on a Window XP Box with Perl 5.8.0.806 installed.
I have a program that I put together that uses, EasyTCP (Socket) and Proc::Fork. It is a Server/Client TCP/IP type of program that sends requests for data back and forth with clients programs over the Internet. The problem I am experiencing is the server software stops intermittly and stops processing clients requests (like it would happening in a deadlock situation, as if both side is waiting for the other side to respond). However, during my investigation, I (only) added printf statements to get a better idea on what going on and the problem disappears. However when I removed my debugging printf statements, the problem comes back. I checked the IO:Select and the IO:Socket Doc and (since version 1.18) autoflush is automatically turned on. I even tried using the trace program "perl -d:Trace server.pl" (using the Devel::Trace module) and the problem disappears.
Any One have any Ideas?
I have attached a copy of the server program for review.
I know, I know, the coding style of this program looks like the old C/UNIX/VI Programmer that never learned on how to code like a true PERL person. haha
Daniel Wilson
Bayesian Edge Technology & Solutions
17260 Gum Landing Road
St. Inigoes Maryland 20684
(301)-872-0230 Phone
(301)-872-0233 Fax
www.bayesianedge.com
Bayesian Edge Technology & Solutions
17260 Gum Landing Road
St. Inigoes Maryland 20684
(301)-872-0230 Phone
(301)-872-0233 Fax
www.bayesianedge.com
#################################################################################################
#
#
#
#
#
#
#
#
# ########### ############ ########### ### ### ############
########## #
# ########### ############ ############ ### ### ############
########### #
# ### ### ### ### ### ### ###
### ### #
# ### ### ### ### ### ### ###
### ### #
# ########### ######### ############ ### ### #########
########### #
# ########### ######### ########### ### ### #########
########## #
# ### ### ### ### ### ### ###
### ### #
# ### ### ### ### ### ### ###
### ### #
# ########### ############ ### ### ##### ############
### ### #
# ########### ############ ### ### ### ############
### ### #
#
#
#
#
# THIS PROGRAM WILL SERVICE ALL REQUEST FROM THE CLIENT.
#
#
#
#
#
# CREATED BY Daniel Wilson 01/06/2003
#
#
#
# MODIFIED ON :
#
#
#
# COPYRIGHT: Bayesian Edge
#
#
#
#
#
#
#
#
#
#
#
#################################################################################################
use warnings; # Setup
Enviornments #
use strict; #
#
use Net::EasyTCP; #
#
use Simran::Log::Log; #
#
use IO::Handle; #
#
use open IN => ":raw", OUT => ":raw"; #
#
#################################################################################################
#################################################################################################
#
#
my $Filename; #
#
my $result; #
#
my $level = 0; #
#
my $ServerPath = "C:/Server/"; #
#
my $rc; # Declare
Working Var.#
my $log; #
#
my $pid = 0; #
#
my $test = 0; #
#
my $heartbeat = "HEARTBEAT"; # Heartbeat
Config #
#
#
$log = Simran::Log::Log->new("/MainLog.txt"); # Start the
Logging #
#################################################################################################
#
#
#################################################################################################
my $PortNum = 0; #
#
$PortNum = shift; #
#
if($PortNum) #
#
{ #
#
if($PortNum =~ /^[0-9]+$/) #
#
{ #
#
$log->write("Port Number [$PortNum]"); #
#
} #
#
else #
#
{ #
#
$log->write("Missing Port Number Argument"); #
#
exit; #
#
} #
#
} #
#
else #
#
{ #
#
$log->write("Missing Port Number Argument"); #
#
exit; #
#
} #
#
###########################################################################
#
# turn on autoflush
#
###########################################################################
#
$|=1; #
#
$SIG{INT} = \&die_handler; #
#
#
#
$result = 'C:/Server/'.$PortNum; #
#
chdir $result; # Change
Working Dir. #
$ServerPath = $result.'/'; #
#
#
#
#
#
my $server = new Net::EasyTCP(
mode => "server",
port => $PortNum,
donotencrypt => 0,
donotcompress => 0,
password => "XXXX",
)
|| die "ERROR CREATING SERVER: [EMAIL PROTECTED]";
$server->setcallback(
data => \&gotdata,
connect => \&connected,
disconnect => \&disconnected,
)
|| die "ERROR SETTING CALLBACKS: [EMAIL PROTECTED]";
$server->start() || die "ERROR STARTING SERVER: [EMAIL PROTECTED]";
sub gotdata()
{
my $client = shift;
my $serial = $client->serial();
my $data = $client->data();
#$log->write("gotdata RECEIVED [$data]");
#print "Client $serial sent me some data, sending it right back to them
again\n";
if($data ne "GO")
{
unless($client->send($data))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
$level = 0;
}
}
if ($level == 0)
{
if ($data eq "QUIT")
{
$log->write("QUIT received from Client");
$client->close();
}
elsif ($data eq "DIE")
{
$log->write("DIE Command received from Client");
unless($server->stop())
{
$log->write("ERROR STOPPING SERVER: $@");
exit;
}
}
elsif ($data eq "DOWNLOAD")
{
$log->write("DOWNLOAD Command received from Client");
$level = 1;
}
elsif ($data eq "VERIFY")
{
$log->write("VERIFY Command received from Client");
$level = 6;
}
elsif ($data eq "REMOVE")
{
$log->write("REMOVE Command received from Client");
$level = 7;
}
elsif ($data eq "RUN")
{
$log->write("RUN Command received from Client");
$level = 3;
}
elsif ($data eq "UPLOAD")
{
$log->write("UPLOAD Command received from Client");
$level = 4;
}
}
elsif ($level == 1)
{
$Filename = $ServerPath. $data; #
#
chomp $Filename; #
#
$result = open(FH1,">$Filename"); #
#
#print "result[$result]filename[$Filename]\n";
if ($result) #
#
{ #
#
$level = 2;
unless($client->send("GOOD"))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
$level = 0;
}
}
else
{
unless($client->send("BAD"))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
}
$log->write("Problem! cannot open file $data");
$level = 0;
}
}
elsif ($level == 2)
{
if($data ne "EOF")
{
print FH1 $data; # Otherwise, copy
it #
}
else
{
$log->write("EOF Received, Closing File");
close(FH1);
$level = 0;
}
}
elsif ($level == 3)
{
$test = 0; #Reset Child Status
$log->write("Calling Perl Script [$data]");
#print("Calling Perl Script [$data]\n");
pipe(PARENTREAD, PARENTWRITE);
PARENTWRITE->autoflush(1);
unless ($pid = fork)
{
close PARENTREAD; #Child doesn't need this
$rc = system($data);
if($? eq 0)
{
print PARENTWRITE "GOOD\n";
}
else
{
print PARENTWRITE "BAD\n";
}
#print("CHILD HELLO [$rc][$?]\n");
#close PARENTWRITE;
exit;
};
#######################
close PARENTWRITE; #PARENT doesn't need this
while($test >= 0)
{
sleep(10);
#$test = waitpid $pid, &WNOHANG;
$test = waitpid $pid, 1;
#print ("PARENT [$pid][$test]\n");
if ($test < 0)
{
chomp($result = <PARENTREAD>);
$log->write("RECEIVED FROM CHILD[$result]");
close PARENTREAD;
}
else
{
unless($client->send($heartbeat))
{
$log->write("UNABLE TO SEND HEARTBEAT, CLIENT MISSING :
$@");
}
}
}
#######################
$log->write("SYSTEM SUBMIT RC:[$result][".$?."]");
unless($client->send($result))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
}
$level = 0;
}
elsif ($level == 4)
{
$Filename = $ServerPath. $data; #
#
chomp $Filename; #
#
$log->write("UPLOADING FILE [$Filename]");
#print("UPLOADING FILE [$Filename]\n");
$result = open(FH2,"<$Filename"); #
#
#print "result[$result]filename[$Filename]\n";
if ($result) #
#
{ #
#
$level = 5;
unless($client->send("GOOD"))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
$level = 0;
}
}
else
{
$log->write("Problem! cannot open file [$data]");
$level = 0;
unless($client->send("BAD"))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
$level = 0;
}
}
#print("DONE UPLOADING FILE [$Filename]\n");
}
elsif ($level == 5)
{
my $line = readline(*FH2); #
#
unless($client->send($line))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
$level = 0;
}
if(eof FH2)
{
unless($client->send("EOF"))
{
$log->write("ERROR SENDING TO CLIENT : $@");
$log->write("CLOSING CLIENT CONNECTION");
$client->close();
}
$log->write("EOF Sent, Closing File");
close(FH2);
$level = 0;
}
}
elsif ($level == 6)
{
if(-e $data)
{
unless($client->send("GOOD"))
{
$log->write("(VERIFY)ERROR SENDING TO CLIENT : $@");
$log->write("(VERIFY)CLOSING CLIENT CONNECTION");
$client->close();
}
}
else
{
unless($client->send("BAD"))
{
$log->write("(VERIFY)ERROR SENDING TO CLIENT : $@");
$log->write("(VERIFY)CLOSING CLIENT CONNECTION");
$client->close();
}
}
$level = 0;
}
elsif ($level == 7)
{
if(rename($data,"C:/TEMP/".$data))
{
unless($client->send("GOOD"))
{
$log->write("(REMOVE)ERROR SENDING TO CLIENT : $@");
$log->write("(REMOVE)CLOSING CLIENT CONNECTION");
$client->close();
}
}
else
{
unless($client->send("BAD"))
{
$log->write("(REMOVE)ERROR SENDING TO CLIENT : $@");
$log->write("(REMOVE)CLOSING CLIENT CONNECTION");
$client->close();
}
}
$level = 0;
}
}
sub connected() {
my $client = shift;
my $serial = $client->serial();
$log->write("Client $serial just connected");
}
sub disconnected() {
my $client = shift;
my $serial = $client->serial();
$log->write("Client $serial just disconnected");
}
sub die_handler() {
my $signal = shift;
$SIG{$signal} = 'IGNORE';
$log->write("Problem! Signal: $signal ");
$log->write("Problem! Program has died : @_ ");
$server->stop();
$SIG{$signal} = \&sig_int;
}
