We are developing flash multiplayer games since 2001 and lately decided to use perl as socket server to make those games more reliable.

We found some samples of the socket server on the web and adjust them to meet our needs.

Finally we developed final version that was working fine ... well .. working fine until it ... stuck! ...

Not crash ... not generating error ... just stuck ... and it stucks without any pattern or rule .. it stucks on the Windows web server and on the Linux as well.

We tried everything from NON-blocking mode .. till SIGALARM for closing opened connections .... nothing worked.

Perl version installed is 5.8

Please have on mind that we needed server that receive data and send them to all connected users .. Flash is doing rest of the job.

Here is the code, and any help would be great

Tnx in advance ...


use IO::Socket;
use IO::Select;

$SIG{PIPE}='IGNORE';
$m=new IO::Socket::INET(Listen=>1,LocalPort=>9098,Reuse=>1);
$O=new IO::Select($m);
$/="\0";
$id=0;
$soketi=0;
$timeout=false;
$strel="%3E%3E";
@users=();
$imeigre="Klikado";

$port=$m->sockport();
print "-=< Perl server V1 >=--------- P:$port ------\n\n";
print " www.green-vector.hr\n";
print " $imeigre\n";
print "--------------------------------------------\n";

sub xlat {
my $N = shift;
foreach $E(@users) {
if ($E->[3]==$N) {
return $E;
}
}
}

sub xterm {
my $N = shift;
foreach $idx(0..$#users) {
if ($users[$idx]->[3]==$N) {
delete $users[$idx];
return;
}
}
}

while(@S=$O->can_read){
foreach(@S){
if($_==$m){
$timeout=false;
eval
{
local $SIG{ALRM} = sub { $timeout=true;die ""; };
alarm 10;
$C=$m->accept;
alarm 0;
};

if ($timeout==false) {
$O->add($C);

foreach $D($O->handles){
if ($D!=$m) {
eval
{
local $SIG{ALRM} = sub { die ""; };
alarm 10;
$T=syswrite($D,"$soketi".$strel."Joined ".$C->peerhost().":".$C->peerport()." as client[$id]\0",2048);
alarm 0;
};
}
}
$#users++;
$users[$#users]->[0]="unknown";
$users[$#users]->[1]="free";
$users[$#users]->[2]=$id;
$users[$#users]->[3]=$C;
$id++;
$soketi++;
}
}
else{
$timeout=false;
eval
{
local $SIG{ALRM} = sub { $timeout=true; die "";};
alarm 10;
$R=sysread($_,$i, 2048);
alarm 0;
};

$X=xlat($_);

if ($timeout!=false) {
$T=syswrite($_,'', 2048);
if($T==undef){
foreach $C($O->handles) {
if ($C!=$m) {
eval
{
local $SIG{ALRM} = sub { die ""; };
alarm 10;
$T=syswrite($C,$X->[2].$strel."gone\0",2048);
alarm 0;
};
}
}
xterm($_);
$O->remove($_);
$soketi--;
}
}
else {
$i=~ s/\0//;

if ($i eq "uigri$strel$strel$strel") {
$X->[1]="uigri";
}

if ($X->[0] eq "unknown") {
$X->[0]=$i;
foreach $C($O->handles) {
if ($C!=$m) {
$Y=xlat($C);
eval
{
local $SIG{ALRM} = sub { die ""; };
alarm 10;
$T=syswrite($_,$Y->[2].$strel.$Y->[0].$strel.$Y->[1]."\0",2048);
alarm 0;
};
}
}
}

if($R==0){
$T=syswrite($_,'', 2048);
if($T==undef){
foreach $C($O->handles) {
if ($C!=$m) {
eval
{
local $SIG{ALRM} = sub { die ""; };
alarm 10;
$T=syswrite($C,$X->[2].$strel."gone\0",2048);
alarm 0;
};
}
}
xterm($_);
$O->remove($_);
$soketi--;
}
}
else{
foreach $C($O->handles){
if (($C!=$_) && ($C!=$m)) {
eval
{
local $SIG{ALRM} = sub { die ""; };
alarm 10;
$T=syswrite($C,$X->[2].$strel.$i.$strel.$X->[1]."\0",2048);
alarm 0;
};
}
}
}
}
}
}
}