PERL Beginners - Threaded chat server

Author

Threaded chat server

Turner

2008-01-13, 7:01 pm

Hello Perl gurus,

I'm currently in the process of writing a chat server in Perl.
Everything is all hunky-dory--it parses commands as it should, and is,
of course, quite satisfying. Except for one thing, and that is that it
cannot handle multiple clients at once, which, needless to say, is
kind of useful for a chat program, isn't it? So I've been following
the discussion online of Threads vs. forking vs. non-blocking IO, and
I've decided to try threads, which is neat because this is the first
thing I've ever done with threading. However, my excitement has been
somewhat dampened by the fact that it does not work. It can still
happily handle a single client--no complaints there. However, it can
still ONLY handle a single client. There's probably a hole in my
understanding of threads (e.g., I don't entirely understand what
join() and detach() DO...). Below is the relevant server code, and I
was hoping some kind soul could look at it, suppress his laughter at
my naive code and point me in the right direction.

Code:
========================================
====================
....
use threads;
....

sub start {
use IO::Socket;

my ($self, %args) = @_;

my $host = $args{'host'} || $self->{'host'};
my $port = $args{'port'} || $self->{'port'};

my $sock = new IO::Socket::INET(
LocalHost => $host,
LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);
$sock or die "Unable to open a port on $host:$port: $!";
print localtime() . ": Started server on $host:$port\n";
$self->{'socket'} = $sock;
$self->{'connected'} = 1;

my ($new_sock, $client_addr);
while(($new_sock, $client_addr) = $sock->accept()) {
my $thread = threads->create(\&handleClient, $self, $new_sock,
$client_addr);
$thread->join();
}
}

========================================
================

Thanks,
Turner

Dr.Ruud

2008-01-14, 8:01 am

Turner schreef:

> I'm currently in the process of writing a chat server in Perl.
> Everything is all hunky-dory--it parses commands as it should, and is,
> of course, quite satisfying. Except for one thing, and that is that it
> cannot handle multiple clients at once, which, needless to say, is
> kind of useful for a chat program, isn't it? So I've been following
> the discussion online of Threads vs. forking vs. non-blocking IO, and
> I've decided to try threads, which is neat because this is the first
> thing I've ever done with threading. However, my excitement has been
> somewhat dampened by the fact that it does not work. It can still
> happily handle a single client--no complaints there. However, it can
> still ONLY handle a single client. There's probably a hole in my
> understanding of threads (e.g., I don't entirely understand what
> join() and detach() DO...). Below is the relevant server code, and I
> was hoping some kind soul could look at it, suppress his laughter at
> my naive code and point me in the right direction.

See also POE. http://search.cpan.org/search?query=POE&mode=module

--
Affijn, Ruud

"Gewoon is een tijger."

Zentara

2008-01-14, 7:02 pm

On Sun, 13 Jan 2008 11:34:36 -0800 (PST), lordlacolith@gmail.com
(Turner) wrote:

>I'm currently in the process of writing a chat server in Perl.
>Everything is all hunky-dory--it parses commands as it should, and is,
>of course, quite satisfying. Except for one thing, and that is that it
>cannot handle multiple clients at once, which, needless to say, is
>kind of useful for a chat program, isn't it? So I've been following
>the discussion online of Threads vs. forking vs. non-blocking IO, and
>I've decided to try threads, which is neat because this is the first
>thing I've ever done with threading. However, my excitement has been
>somewhat dampened by the fact that it does not work. It can still
>happily handle a single client--no complaints there. However, it can
>still ONLY handle a single client. There's probably a hole in my
>understanding of threads (e.g., I don't entirely understand what
>join() and detach() DO...). Below is the relevant server code, and I
>was hoping some kind soul could look at it, suppress his laughter at
>my naive code and point me in the right direction.

This code is the only threaded chat server which seems to work.
It may show you the way.

See http://perlmonks.org/?node_id=319472

It's tricky to use dynamically spawned threads, because each successive
thread gets a copy of the parent. This can cause confusion in the
IO::Select object ( and that is probably why your code handles only 1
client), but I havn't tested it.

Also you will need a bidirectional client to work with the above server.

#!/usr/bin/perl -w
use strict;
use IO::Socket;
# bi-directional client

my ( $host, $port, $kidpid, $handle, $line );

( $host, $port ) = ('192.168.0.1',3333);

#my $name = shift || '';
#if($name eq ''){print "What's your name?\n"}
#chomp ($name = <> );

# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port
)
or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # so output gets there right away
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins
die "can't fork: $!" unless defined( $kidpid = fork() );

# the if{} block runs only in the parent process
if ($kidpid) {

# copy the socket to standard output
while ( defined( $line = <$handle> ) ) {
print STDOUT $line;
}
kill( "TERM", $kidpid ); # send SIGTERM to child
}

# the else{} block runs only in the child process
else {

# copy standard input to the socket
while ( defined( $line = <STDIN> ) ) {
#print $handle "$name->$line";
print $handle "$line";
}
}
__END__

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Robert Leibl

2008-01-14, 7:02 pm

Turner wrote:
> Hello Perl gurus,
>
> I'm currently in the process of writing a chat server in Perl.
> Everything is all hunky-dory--it parses commands as it should, and is,
> of course, quite satisfying. Except for one thing, and that is that it
> cannot handle multiple clients at once, which, needless to say, is
> kind of useful for a chat program, isn't it? So I've been following
> the discussion online of Threads vs. forking vs. non-blocking IO, and
> I've decided to try threads, which is neat because this is the first
> thing I've ever done with threading. However, my excitement has been
> somewhat dampened by the fact that it does not work. It can still
> happily handle a single client--no complaints there. However, it can
> still ONLY handle a single client. There's probably a hole in my
> understanding of threads (e.g., I don't entirely understand what
> join() and detach() DO...). Below is the relevant server code, and I
> was hoping some kind soul could look at it, suppress his laughter at
> my naive code and point me in the right direction.
>
[...]

If you just want to handle multiple clients, you may want to look at the
select() function.
(See the bottom part in the perldoc-umentation. The one with RBITS,
WBITS, ... or here
http://www.perlfect.com/articles/select.shtml)

Turner

2008-01-14, 7:02 pm

On Jan 14, 9:31 am, zent...@highstream.net (Zentara) wrote:
> On Sun, 13 Jan 2008 11:34:36 -0800 (PST), lordlacol...@gmail.com
>
>
>
> (Turner) wrote:
>
> This code is the only threaded chat server which seems to work.
> It may show you the way.
>
> Seehttp://perlmonks.org/?node_id=319472
>
> It's tricky to use dynamically spawned threads, because each successive
> thread gets a copy of the parent. This can cause confusion in the
> IO::Select object ( and that is probably why your code handles only 1
> client), but I havn't tested it.
>
> Also you will need a bidirectional client to work with the above server.
>
> #!/usr/bin/perl -w
> use strict;
> use IO::Socket;
> # bi-directional client
>
> my ( $host, $port, $kidpid, $handle, $line );
>
> ( $host, $port ) = ('192.168.0.1',3333);
>
> #my $name = shift || '';
> #if($name eq ''){print "What's your name?\n"}
> #chomp ($name = <> );
>
> # create a tcp connection to the specified host and port
> $handle = IO::Socket::INET->new(
> Proto => "tcp",
> PeerAddr => $host,
> PeerPort => $port
> )
> or die "can't connect to port $port on $host: $!";
> $handle->autoflush(1); # so output gets there right away
> print STDERR "[Connected to $host:$port]\n";
>
> # split the program into two processes, identical twins
> die "can't fork: $!" unless defined( $kidpid = fork() );
>
> # the if{} block runs only in the parent process
> if ($kidpid) {
>
> # copy the socket to standard output
> while ( defined( $line = <$handle> ) ) {
> print STDOUT $line;
> }
> kill( "TERM", $kidpid ); # send SIGTERM to child
>
> }
>
> # the else{} block runs only in the child process
> else {
>
> # copy standard input to the socket
> while ( defined( $line = <STDIN> ) ) {
> #print $handle "$name->$line";
> print $handle "$line";
> }}
>
> __END__
>
> zentara
>
> --
> I'm not really a human, but I play one on earth.http://zentara.net/japh.html

So what was my problem in the above code? Does thread creation block
in some way? Why didn't my loop spawn off a separate thread for each
incoming connection? If each gets a copy of the parent, as you said,
why is it that it only seems to read one socket (the first client)?

Thanks,
Turner

Turner

2008-01-15, 4:02 am

On Jan 14, 4:07 pm, robert.le...@gmail.com (Robert Leibl) wrote:
> Turner wrote:
>
>
> [...]
>
> If you just want to handle multiple clients, you may want to look at the
> select() function.
> (See the bottom part in the perldoc-umentation. The one with RBITS,
> WBITS, ... or herehttp://www.perlfect.com/articles/select.shtml)

Thank you, that was exactly what I needed. It works beautifully now.
Thanks.

Zentara

2008-01-15, 7:02 pm

On Mon, 14 Jan 2008 20:26:05 -0800 (PST), lordlacolith@gmail.com
(Turner) wrote:

>On Jan 14, 4:07 pm, robert.le...@gmail.com (Robert Leibl) wrote:
>
>Thank you, that was exactly what I needed. It works beautifully now.
>Thanks.

Hi, would you mind posting the complete working code?
I would like to test it
for good functionality and no memory leaks with repeated
connects/disconnects.

Thanks, zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Turner

2008-01-16, 4:02 am

On Jan 15, 9:23 am, zent...@highstream.net (Zentara) wrote:
> On Mon, 14 Jan 2008 20:26:05 -0800 (PST), lordlacol...@gmail.com
>
>
>
> (Turner) wrote:
>
>
>
>
>
> Hi, would you mind posting the complete working code?
> I would like to test it
> for good functionality and no memory leaks with repeated
> connects/disconnects.
>
> Thanks, zentara
>
> --
> I'm not really a human, but I play one on earth.http://zentara.net/japh.html

I would normally happily do so, but this program is part of an
application to a programming job, so I'm being cautious as to how much
and what kind of help I get, and I think posting it here for you to
debug would be kind of cheating. But I really appreciate the offer,
and in other circumstances, I'd certainly oblige.

However, I think general questions are legit. And with that in mind, I
have some questions about IO::Select. While my server runs as it
should, it eats up a ton of CPU cycles; when it's running, my computer
slows noticably. Windows Task Manager shows it taking about 50% of the
CPU. This is obscene. I'm pretty sure it shouldn't have that big a
footprint. I've done some cursory profiling with -d:DProf and the
problem seems to center around IO::Select::select--in one run of about
a minute or so, there were 280395 calls to IO::Select::select. I think
this is probably where most of the performance pit is. Any ideas on
how to fix it?

Thanks,
Turner

Zentara

2008-01-16, 7:02 pm

On Tue, 15 Jan 2008 19:18:02 -0800 (PST), lordlacolith@gmail.com
(Turner) wrote:

>On Jan 15, 9:23 am, zent...@highstream.net (Zentara) wrote:
[color=darkred]
[color=darkred]
>I would normally happily do so, but this program is part of an
>application to a programming job, so I'm being cautious as to how much
>and what kind of help I get, and I think posting it here for you to
>debug would be kind of cheating. But I really appreciate the offer,
>and in other circumstances, I'd certainly oblige.
>
>However, I think general questions are legit. And with that in mind, I
>have some questions about IO::Select. While my server runs as it
>should, it eats up a ton of CPU cycles; when it's running, my computer
>slows noticably. Windows Task Manager shows it taking about 50% of the
>CPU. This is obscene. I'm pretty sure it shouldn't have that big a
>footprint. I've done some cursory profiling with -d:DProf and the
>problem seems to center around IO::Select::select--in one run of about
>a minute or so, there were 280395 calls to IO::Select::select. I think
>this is probably where most of the performance pit is. Any ideas on
>how to fix it?
>Thanks,
>Turner

Well, that is why I asked to see the code. It seemed suspicious that it
worked beautifully. :-)

The thing that didn't seem to jive (I use linux, so windows may act
differently), is using IO::Select with threads.

Generally, IO::Select is NOT compatible with using threads. IO:Select
is usually used instead of threads.

Typically, an IO::Select server, is preferred, because it handles
multiple connects/disconnects very well. BUT it has a drawback,
select can only handle one filehandle at a time. So for short chat
messages, it works fine, and can handle alot of connections efficiently.

The problem comes when you want to upload big files. Select will block
all other clients while the big upload occurs. In those big-file cases,
you need to fork off to handle the client, and is called a
forking-chat-server.
Alternatively, to forking, you can spawn threads to handle each client.
Using threads, would typically not require Select. The thread would be
handed the client socket filehandle, and you can just use IO::Socket
commands to read or write to it.

This is just basiccally tested, but shows the idea of not needing
IO::Select_when using threads.

#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use threads;

$|++;

my $server = new IO::Socket::INET(
Timeout => 7200,
Proto => "tcp",
LocalPort => 12345,
Reuse => 1,
Listen => 2
);
my $num_of_client = -1;

while (1) {
my $client;

do {
$client = $server->accept;
} until ( defined($client) );

my $peerhost = $client->peerhost();
print "accepted a client $client, $peerhost, id = ",
++$num_of_client, "\n";

#spawn a thread here for each client
my $thr = threads->new( \&processit,$client,$peerhost )->detach();

}

sub processit {
my ($lclient,$lpeer) = @_; #local client

if($lclient->connected){
# Here you can do your stuff
# I use have the server talk to the client
# via print $client and while(<$lclient> )
print $lclient "$lpeer->Welcome to server\n"; #and
while(<$lclient> ){print $lclient "$lpeer->$_\n"}

}

#close filehandle before detached thread dies out
close( $lclient);
}
)

__END__

Of course there are ALL sorts of missing details. Like do you want
a "multi-echo chat server" where all clients gets messages from all
clients? If so, it is more difficult with threads, you will need some
shared array to keep all socket filehandles in. How to kill a thread
prematurely? etc. etc.

The most time tested, and best working chat servers are those
that fork and use IO::Select. BUT windows emulates fork with threads,
so I can't say whether you are better off on windows, directly using
threads.

But the above is the basic idea for threads.

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Turner

2008-01-16, 7:02 pm

On Jan 16, 11:50 am, zent...@highstream.net (Zentara) wrote:
> On Tue, 15 Jan 2008 19:18:02 -0800 (PST), lordlacol...@gmail.com
>
>
>
> (Turner) wrote:
>
>
>
>
>
>
> Well, that is why I asked to see the code. It seemed suspicious that it
> worked beautifully. :-)
>
> The thing that didn't seem to jive (I use linux, so windows may act
> differently), is using IO::Select with threads.
>
> Generally, IO::Select is NOT compatible with using threads. IO:Select
> is usually used instead of threads.
>
> Typically, an IO::Select server, is preferred, because it handles
> multiple connects/disconnects very well. BUT it has a drawback,
> select can only handle one filehandle at a time. So for short chat
> messages, it works fine, and can handle alot of connections efficiently.
>
> The problem comes when you want to upload big files. Select will block
> all other clients while the big upload occurs. In those big-file cases,
> you need to fork off to handle the client, and is called a
> forking-chat-server.
> Alternatively, to forking, you can spawn threads to handle each client.
> Using threads, would typically not require Select. The thread would be
> handed the client socket filehandle, and you can just use IO::Socket
> commands to read or write to it.
>
> This is just basiccally tested, but shows the idea of not needing
> IO::Select when using threads.
>
> #!/usr/bin/perl
> use warnings;
> use strict;
> use IO::Socket;
> use threads;
>
> $|++;
>
> my $server = new IO::Socket::INET(
> Timeout => 7200,
> Proto => "tcp",
> LocalPort => 12345,
> Reuse => 1,
> Listen => 2
> );
> my $num_of_client = -1;
>
> while (1) {
> my $client;
>
> do {
> $client = $server->accept;
> } until ( defined($client) );
>
> my $peerhost = $client->peerhost();
> print "accepted a client $client, $peerhost, id = ",
> ++$num_of_client, "\n";
>
> #spawn a thread here for each client
> my $thr = threads->new( \&processit,$client,$peerhost )->detach();
>
> }
>
> sub processit {
> my ($lclient,$lpeer) = @_; #local client
>
> if($lclient->connected){
> # Here you can do your stuff
> # I use have the server talk to the client
> # via print $client and while(<$lclient> )
> print $lclient "$lpeer->Welcome to server\n"; #and
> while(<$lclient> ){print $lclient "$lpeer->$_\n"}
>
> }
>
> #close filehandle before detached thread dies out
> close( $lclient);}
>
> )
>
> __END__
>
> Of course there are ALL sorts of missing details. Like do you want
> a "multi-echo chat server" where all clients gets messages from all
> clients? If so, it is more difficult with threads, you will need some
> shared array to keep all socket filehandles in. How to kill a thread
> prematurely? etc. etc.
>
> The most time tested, and best working chat servers are those
> that fork and use IO::Select. BUT windows emulates fork with threads,
> so I can't say whether you are better off on windows, directly using
> threads.
>
> But the above is the basic idea for threads.
>
> zentara
>
> --
> I'm not really a human, but I play one on earth.http://zentara.net/japh.html

I think you may have misunderstood me. I'm now using exclusively
IO::Select--I dumped threads entirely (it's not you, threads, it's
me). I don't use fork either, now--just IO::Select. I got the
impression that fork would be kind of redundant with IO::Select.
Here's a snippet of my IO::Select code:

Code:
========================================
=========================

sub start {
use IO::Socket;

my ($self) = @_;

my $host = $self->{'host'};
my $port = $self->{'port'};

my $sock = new IO::Socket::INET(
LocalHost => $host,
LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);

use IO::Select;

my $select_set = new IO::Select();
$select_set->add($sock); #Add listening socket to select

while(1) {
my ($readables) = IO::Select->select($select_set, undef, undef, 0);

foreach my $r (@$readables) {
if($r == $sock) {
my ($new_sock, $client_addr) = $r->accept();
$select_set->add($new_sock);
...process new socket...
}
else {
if(defined(my $buf = <$r> )) {
..process $buf..
}
#Client closed connection
else {
$select_set->remove($r);
close($r);
}
}
}
}
}

========================================
===========================

I basically took that straight from the tutorial Robert Leibl linked
me to here. It handles mutiple (well, two) clients appropriately--
everything works as it should, just with a lot more CPU usage than it
should

Zentara

2008-01-17, 8:01 am

On Wed, 16 Jan 2008 14:08:14 -0800 (PST), lordlacolith@gmail.com
(Turner) wrote:

>On Jan 16, 11:50 am, zent...@highstream.net (Zentara) wrote:
[color=darkred]
>I think you may have misunderstood me. I'm now using exclusively
>IO::Select--I dumped threads entirely (it's not you, threads, it's
>me). I don't use fork either, now--just IO::Select. I got the
>impression that fork would be kind of redundant with IO::Select.
>Here's a snippet of my IO::Select code:
>
>
>Code:
> ========================================
=========================
>
>sub start {
> use IO::Socket;
>
> my ($self) = @_;
>
> my $host = $self->{'host'};
> my $port = $self->{'port'};
>
> my $sock = new IO::Socket::INET(
> LocalHost => $host,
> LocalPort => $port,
> Proto => 'tcp',
> Listen => SOMAXCONN,
> Reuse => 1);
>
> use IO::Select;
>
> my $select_set = new IO::Select();
> $select_set->add($sock); #Add listening socket to select
>
>
> while(1) {

the while(1) looks like it may cause heavy load, usually
it's something like

while ( my @ready = $select->can_read() ) { .... }

see below for a different sub

> my ($readables) = IO::Select->select($select_set, undef, undef, 0);
>
> foreach my $r (@$readables) {
> if($r == $sock) {
> my ($new_sock, $client_addr) = $r->accept();
> $select_set->add($new_sock);
> ...process new socket...
> }
> else {
> if(defined(my $buf = <$r> )) {
> ..process $buf..
> }
> #Client closed connection
> else {
> $select_set->remove($r);
> close($r);
> }
> }
> }
> }
>}
>
> ========================================
===========================
>
>I basically took that straight from the tutorial Robert Leibl linked
>me to here. It handles mutiple (well, two) clients appropriately--
>everything works as it should, just with a lot more CPU usage than it
>should

Try this: (variables named slightly different)

#!/usr/bin/perl
use strict;
use IO::Socket;
use IO::Select;

my $listen = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => 9192,
Listen => 5,
Reuse => 1) or die $!;

my $select = IO::Select->new($listen);

my @ready;

while(@ready = $select->can_read) {
my $socket;
for $socket (@ready) {

if($socket == $listen) {
my $new = $listen->accept;
$select->add($new);
print $new->fileno . ": connected\n";
} else {
my $line="";
$socket->recv($line,80);
if($line eq "") {
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
};
print "$line\n";

my $socket;
for $socket ($select->handles) {
next if($socket==$listen);
$socket->send($line) or do {
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
};
}
}
}
}
__END__

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Turner

2008-01-18, 7:02 pm

On Jan 17, 8:44 am, zent...@highstream.net (Zentara) wrote:
> On Wed, 16 Jan 2008 14:08:14 -0800 (PST), lordlacol...@gmail.com
>
>
>
> (Turner) wrote:
>
>
>
>
>
>
>
>
>
>
> the while(1) looks like it may cause heavy load, usually
> it's something like
>
> while ( my @ready = $select->can_read() ) { .... }
>
> see below for a different sub
>
>
>
>
>
>
>
> Try this: (variables named slightly different)
>
> #!/usr/bin/perl
> use strict;
> use IO::Socket;
> use IO::Select;
>
> my $listen = IO::Socket::INET->new(
> Proto => 'tcp',
> LocalPort => 9192,
> Listen => 5,
> Reuse => 1) or die $!;
>
> my $select = IO::Select->new($listen);
>
> my @ready;
>
> while(@ready = $select->can_read) {
> my $socket;
> for $socket (@ready) {
>
> if($socket == $listen) {
> my $new = $listen->accept;
> $select->add($new);
> print $new->fileno . ": connected\n";
> } else {
> my $line="";
> $socket->recv($line,80);
> if($line eq "") {
> print $socket->fileno . ": disconnected\n";
> $select->remove($socket);
> $socket->close;
> };
> print "$line\n";
>
> my $socket;
> for $socket ($select->handles) {
> next if($socket==$listen);
> $socket->send($line) or do {
> print $socket->fileno . ": disconnected\n";
> $select->remove($socket);
> $socket->close;
> };
> }
> }
> }}
>
> __END__
>
> zentara
>
> --
> I'm not really a human, but I play one on earth.http://zentara.net/japh.html

Zentara, you are a lifesaver. That made it much better. I took the
while(1) idea from the linked tutorial, but it makes sense to loop on
a blocking read (the one time in this project that blocking is
useful). It's much better now, thank you so much.

Turner

Sponsored Links