From: A. Farber on
Hello,

I have a multiplayer game (at preferans.de)
as a non-forking server in Perl (v5.10.0 under
OpenBSD 4.5) and it runs mostly okay with
average of 10 connected users and uses 0.2% CPU.

However once in a week the perl process would
"spin up" up to 98% CPU and would stop responding.

It is difficult to find the reason for this and
I can't reproduce it while testing myself.

I've made the listening TCP socket
non-blocking to prevent DOS attacks and
the main loop in my server looks like this:

sub prepare {
my $pkg = shift;

for my $child (values %Kids) {
my $fh = $child->{FH};

# the outgoing buffer is not empty - add POLLOUT
if (length $child->{RESPONSE} != 0) {
$Poll->mask($fh => POLLIN|POLLERR|POLLHUP|
POLLOUT);
} else {
$Poll->mask($fh => POLLIN|POLLERR|POLLHUP);
}
}
}

sub loop {
my $pkg = shift;
LOOP:
while (not $Quit) {
$pkg->prepare();

if ($Poll->poll(TIMEOUT) < 0) {
warn "poll error: $!\n";
next LOOP;
}

# add the new client
if ($Poll->events($tcpSocket) & POLLIN) {
$pkg->add($tcpSocket);
}

for my $child (values %Kids) {
my $fh = $child->{FH};
my $mask = $Poll->events($fh);

if ($mask & (POLLERR|POLLHUP)) {
$child->remove();
next LOOP;
} elsif ($mask & POLLOUT) {
unless ($child->write()) {
$child->remove();
next LOOP;
}
} elsif ($mask & POLLIN) {
unless ($child->read()) {
$child->remove();
next LOOP;
}
}
}
}
}

The client sockets are non-blocking too
and I try to ignore (i.e. retry sysread/write)
on signals and would-block situations:

sub write {
my $child = shift;
my $fh = $child->{FH};
my $len = bytes::length $child->{RESPONSE};
my $nbytes;

$nbytes = $fh->syswrite($child->{RESPONSE}, $len);

unless (defined $nbytes) {
# would block - retry later
return 1 if $!{EAGAIN} || $!{EWOULDBLOCK};

# interrupted by signal - retry later
return 1 if $!{EINTR};
# connection interrupted
return 0;
}

# connection closed
return 0 if 0 == $nbytes;

substr $child->{RESPONSE}, 0, $nbytes, '';
return 1;
}

I wonder, if this retrying (as shown above)
is the real reason for the "spin-ups" somehow?
Should I maybe clear $!{EINTR} etc.
manually whenever $nbytes is undefined?

Another suspicious spot for me is the
main loop, where I remove clients while looping
(that's why I've added "next LOOP" everywhere)

Does anybody have any advices?

Regards
Alex
From: Ben Morrow on

Quoth "A. Farber" <alexander.farber(a)gmail.com>:
>
> However once in a week the perl process would
> "spin up" up to 98% CPU and would stop responding.
>
> It is difficult to find the reason for this and
> I can't reproduce it while testing myself.
>
> I've made the listening TCP socket
> non-blocking to prevent DOS attacks and
> the main loop in my server looks like this:
>
<snip>
>
> sub write {
> my $child = shift;
> my $fh = $child->{FH};
> my $len = bytes::length $child->{RESPONSE};

Don't use bytes::length. If $child->{RESPONSE} might contain Unicode
characters, you need to pass it through Encode::encode before
transmitting it.

> my $nbytes;
>
> $nbytes = $fh->syswrite($child->{RESPONSE}, $len);
>
> unless (defined $nbytes) {
> # would block - retry later
> return 1 if $!{EAGAIN} || $!{EWOULDBLOCK};
>
> # interrupted by signal - retry later
> return 1 if $!{EINTR};
> # connection interrupted
> return 0;
> }
>
> # connection closed
> return 0 if 0 == $nbytes;
>
> substr $child->{RESPONSE}, 0, $nbytes, '';
> return 1;
> }
>
> I wonder, if this retrying (as shown above)
> is the real reason for the "spin-ups" somehow?
> Should I maybe clear $!{EINTR} etc.
> manually whenever $nbytes is undefined?

No, $!{EINTR} is exactly equivalent to ($! == EINTR).

Ben

From: A. Farber on
Hello Ben,

On May 14, 3:08 pm, Ben Morrow <b...(a)morrow.me.uk> wrote:
> Quoth "A. Farber" <alexander.far...(a)gmail.com>:
> > my $len = bytes::length $child->{RESPONSE};
>
> Don't use bytes::length. If $child->{RESPONSE} might contain Unicode
> characters, you need to pass it through Encode::encode before
> transmitting it.
>
> > $nbytes = $fh->syswrite($child->{RESPONSE}, $len);

yes it contains Unicode (cyrillic + latin chars in UTF8).
If I pass it through encode and do not use bytes::length
as you suggest, how will I get the number of bytes for syswrite?


> > unless (defined $nbytes) {
> > # would block - retry later
> > return 1 if $!{EAGAIN} || $!{EWOULDBLOCK};
>
> > # interrupted by signal - retry later
> > return 1 if $!{EINTR};
> > # connection interrupted
> > return 0;
> > }

> No, $!{EINTR} is exactly equivalent to ($! == EINTR).

Ok, but for example: sysreading from one socket fails
with $!{EINTR} (because I use USR1 and -USR2
in my script to dump data structures). I do not close
that socket and plan to sysread from it again in next loop.

Then sysreading from another socket fails, because
TCP-connection has been interrupted.

Will $!{EINTR} be cleared or still set (from the prev. socket)?

Regards
Alex
From: Uri Guttman on
>>>>> "AF" == A Farber <alexander.farber(a)gmail.com> writes:

AF> Hello Ben,
AF> On May 14, 3:08 pm, Ben Morrow <b...(a)morrow.me.uk> wrote:
>> Quoth "A. Farber" <alexander.far...(a)gmail.com>:
>> > my $len = bytes::length $child->{RESPONSE};
>>
>> Don't use bytes::length. If $child->{RESPONSE} might contain Unicode
>> characters, you need to pass it through Encode::encode before
>> transmitting it.
>>
>> > $nbytes = $fh->syswrite($child->{RESPONSE}, $len);

AF> yes it contains Unicode (cyrillic + latin chars in UTF8).
AF> If I pass it through encode and do not use bytes::length
AF> as you suggest, how will I get the number of bytes for syswrite?

syswrite can skip the len argument and just send what is in the
buffer. i haven't tried this with utf but it should work just
fine. internally it will see how many bytes are in the buffer and send
that.

uri

--
Uri Guttman ------ uri(a)stemsystems.com -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------
From: Ben Morrow on

Quoth "A. Farber" <alexander.farber(a)gmail.com>:
> Hello Ben,
>
> On May 14, 3:08 pm, Ben Morrow <b...(a)morrow.me.uk> wrote:
> > Quoth "A. Farber" <alexander.far...(a)gmail.com>:
> > > my $len = bytes::length $child->{RESPONSE};
> >
> > Don't use bytes::length. If $child->{RESPONSE} might contain Unicode
> > characters, you need to pass it through Encode::encode before
> > transmitting it.
> >
> > > $nbytes = $fh->syswrite($child->{RESPONSE}, $len);
>
> yes it contains Unicode (cyrillic + latin chars in UTF8).
> If I pass it through encode and do not use bytes::length
> as you suggest, how will I get the number of bytes for syswrite?

If it's a true Unicode string, then you need

my $bytes = Encode::encode "UTF-8" => $child->{RESPONSE};
my $len = length $bytes;

$nbytes = $fh->syswrite($bytes, $len);

You will also need to fix the buffer-trimming logic below, to work on
the byte string instead of the character string. You may need a new
entry in $child, $child->{RESPONSE_BYTES}, to hold the section of the
string that's been encoded but hasn't been transmitted yet.

If it's already encoded in UTF8 (so that, as far as Perl is concerned,
none of the characters have ord > 255) then just replace bytes::length
with length.

> > > unless (defined $nbytes) {
> > > # would block - retry later
> > > return 1 if $!{EAGAIN} || $!{EWOULDBLOCK};
> >
> > > # interrupted by signal - retry later
> > > return 1 if $!{EINTR};
> > > # connection interrupted
> > > return 0;
> > > }
>
> > No, $!{EINTR} is exactly equivalent to ($! == EINTR).
>
> Ok, but for example: sysreading from one socket fails
> with $!{EINTR} (because I use USR1 and -USR2
> in my script to dump data structures). I do not close
> that socket and plan to sysread from it again in next loop.
>
> Then sysreading from another socket fails, because
> TCP-connection has been interrupted.
>
> Will $!{EINTR} be cleared or still set (from the prev. socket)?

$!{EINTR} will still be true if and only if $! is still equal to EINTR.
%! is readonly, and you will get an error if you try to set or clear any
of the entries yourself.

Ben