Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Simple threaded chat server

by zentara (Archbishop)
on Jan 17, 2008 at 18:19 UTC ( #662931=snippet: print w/ replies, xml ) Need Help??

Description: I've seen quite a few questions lately about threaded chat servers. Sockets are confusing enough, but when you add threads into it, complete mayhem occurs as newbies mix up IO::Select, threads, and forking. Well, here are 2 very basic snippets for threaded chat. The first is non-echo( it connects to many private single clients). The second is multi-echo-chat. It's only trick is the use of fileno's to share socket filehandles across threads. And finally, a Tk client for testing the servers.

Of course, threaded servers are not better than forking servers, but they can handle big file transfers without blocking( like select). The drawback is the memory footprint will rise and stay at peak usage.

# a private channel server
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use threads;
$|++;

print $$;

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_cli
+ent, "\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 
          #$lclient->recv;
          while(<$lclient>){print $lclient "$lpeer->$_\n"}
        
    }
  
  #close filehandle before detached thread dies out
  close( $lclient);
}
__END__
# slightly modified version of above to add multi-echo-chat
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use threads;
use threads::shared;
$|++;
print "$$ Server started\n";;  # do a "top -p -H $$" to monitor server
+ threads

our @clients : shared;
@clients = ();

my $server = new IO::Socket::INET(
    Timeout   => 7200,
    Proto     => "tcp",
    LocalPort => 12345,
    Reuse     => 1,
    Listen    => 3
);
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_cli
+ent, "\n";
    my $fileno = fileno $client;
    push (@clients, $fileno);
    #spawn  a thread here for each client
    my $thr = threads->new( \&processit, $client, $fileno, $peerhost )
+->detach(); 
}
# end of main thread

sub processit {
     my ($lclient,$lfileno,$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";  
          
          while(<$lclient>){
             # print $lclient "$lpeer->$_\n";
              print "clients-> @clients\n";           
              
              foreach my $fn (@clients) { 
                  open my $fh, ">&=$fn" or warn $! and die;
                  print $fh  "$lpeer->$_"  
                  }
           
           }
        
    }
  
  #close filehandle before detached thread dies out
  close( $lclient);
  #remove multi-echo-clients from echo list
  @clients = grep {$_ !~ $lfileno} @clients;

}
__END__
# and finally a Tk client to test with
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use IO::Socket;

require Tk::ROText;

#get id
my $name = shift || 'anon';

# create the socket
my $host = 'localhost';
my $port = 12345;

my $socket = IO::Socket::INET->new(
       PeerAddr => $host,
       PeerPort => $port,
       Proto    => 'tcp',
      );

defined $socket or die "ERROR: Can't connect to port $port on $host: $
+!\n";

print STDERR "Connected to server ...\n";

my $mw  = new MainWindow;
my $log = $mw->Scrolled('ROText',
           -scrollbars=>'ose',
           -height=> 5,
           -width=>45,
           -background => 'lightyellow',
           )->pack;

my $txt = $mw->Entry(
          -background=>'white',
          )->pack(-fill=> 'x', -pady=> 5);

$mw ->bind('<Any-Enter>' => sub { $txt->Tk::focus });
$txt->bind('<Return>' => [\&broadcast, $socket]);

$mw ->fileevent($socket, readable => sub {
                    my $line = <$socket>;
                      unless (defined $line) {
                       $mw->fileevent($socket => readable => '');
                       return;
                       }
         $log->insert(end => $line);
         $log->see('end');
  });


MainLoop;

sub broadcast {
    my ($ent, $sock) = @_;

    my $text = $ent->get;
    $ent->delete(qw/0 end/);

    print $sock $name.'->'. $text, "\n";
}
__END__

Comment on Simple threaded chat server
Select or Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://662931]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (8)
As of 2014-07-31 23:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (255 votes), past polls