SERVER:
####################################################
#!/usr/bin/perl
use warnings;
use strict;
use Net::EasyTCP;

$|=1;

my $debug = 0; # set to 1 for verbose server messages

local $SIG{INT} = sub { close LOG;print "Exiting\n";exit 0;};
print "Hit control-c to stop server\n";

my @nocrypt = qw(Crypt::RSA); #too slow, but more secure
#my @nocompress = qw(Compress::LZF); #just testing 

my $host = "localhost";
my $port = "2345";
my $portpassword = "tkscrabble";
my $logdir = 'logs';
my %okusers = (user1 => '1',
               user2 => '2',
               user3 => '3',
               user4 => '4',
                test => 'test',
            joe  => 'zzzz',
        );
            
my %clients;
          
if (! -d $logdir) {
         mkdir($logdir,0755) ;
         print "Log directory created: $logdir\n" ;
         }

my $logname = "port_$port-".&gettime.'.log';  #try to give a unique na
+me
open (LOG,">>$logdir/$logname") 
       or die "Couldn't open port $port log: $!";

my $server = new Net::EasyTCP(
    host  =>  "localhost", 
    mode  =>  "server",
    port  =>   $port,
    password => $portpassword,  # if using asymmetric encryption, 
                                # port password gives better security
    donotencryptwith => \@nocrypt,
#    donotencrypt => 1,
#    donotcompresswith => \@nocompress,
#    donotcompress => 1,
    )
       || die "ERROR CREATING SERVER: $@\n";

$server->setcallback(
     data            =>      \&gotdata,
     connect         =>      \&connected,
     disconnect      =>      \&disconnected,
    )
     || die "ERROR SETTING CALLBACKS: $@\n";

$server->start() || die "ERROR STARTING SERVER: $@\n";
####################################################
sub gotdata() {

my $client = shift;
print "client->$client\n" if $debug;
my $serial = $client->serial();
my $data = $client->data();
my $reply;

#logon
if(! defined  $clients{$serial}{'username'}){
   my $user = $data->{'user'};
   print "user->$user\n" if $debug;
   my $pass = $data->{'pass'};
   print "pass->$pass\n" if $debug;

$reply = &process_user($user,$pass,$serial,$client);
  print "$reply\n" if $debug;
$client->send($reply);
}
#logged in here

print " $serial->$data\n" if $debug;
print "$clients{$serial}{'username'}->$data\n" if $debug;

foreach my $sernum( keys %clients){
   if(defined $clients{$sernum}{'socket'}){

$clients{$sernum}{'socket'}->send("$clients{$serial}{'username'}->$dat
+a\n")
                      || die "ERROR SENDING TO CLIENT: $@\n";
     }
}

if ($data eq "QUIT") {
    $client->close() || die "ERROR CLOSING CLIENT: $@\n";
  }
   elsif ($data eq "DIE") {
    $server->stop() || die "ERROR STOPPING SERVER: $@\n";
    }

}
#####################################################
sub connected() {
 my $client = shift;
 my $serial = $client->serial();
 print "Client $serial just connected\n";
 print LOG "Client $serial just connected at ",gettime(),"\n";
 $client->send('LOGIN') || die "ERROR SENDING LOGIN TO CLIENT: $@\n";
}
###################################################
sub disconnected() {
 my $client = shift;
 my $serial = $client->serial();

 print "$clients{$serial}{'username'} just disconnected\n";
 print LOG "$clients{$serial}{'username'} just disconnected at
",&gettime,"\n";

foreach my $sernum( keys %clients){
   if(defined $clients{$sernum}{'socket'}){

$clients{$sernum}{'socket'}->send("$clients{$serial}{'username'}->Has
Logged Out\n") 
                      || die "ERROR SENDING TO CLIENT: $@\n";
    }
}

delete $clients{$serial}{'username'};
delete $clients{$serial}{'socket'};
delete $clients{$serial};
}

###########################################################
sub process_user{
my ($user,$pass,$serial,$client) = @_; 

print "proceesing $user $pass\n" if $debug;
my $reply;
my $time = gettime();

if((! defined $okusers{$user}) or ($pass ne $okusers{$user}))
        { print LOG "BADPASSWORD  $user  $pass  $time\n"; LOG->flush;
      $reply = "ERROR1: user or password id bad\n";
          return $reply;
     }

$reply = "OK-SEND->$user";
print "$reply\n";
print LOG "$reply at $time\n"; LOG->flush;
$clients{$serial}{'username'} = $user;
$clients{$serial}{'socket'} = $client;
print "$reply\n" if $debug;
return $reply;
}

#####################################################
sub gettime{
 my $date_string = localtime;
 $date_string =~ tr/ /_/;
 return $date_string;
}
######################################################3
__END__






CLIENT
#####################################################
#!/usr/bin/perl
use warnings;
use strict;
use Net::EasyTCP;
use Tk;
use Tk::ROText;
use IO::Select;

# create the socket

my $user = 'user1';
my $pass = 1;

my $host = "localhost";
my $port = "2345";
my $portpassword = "tkscrabble";
my %hash;     #global used for sending data  
my $sendmode = 0;  #flag to switch between send and receive mode 

my $client = new Net::EasyTCP(
mode            =>      "client",
host            =>      'localhost',
port            =>      $port,
password        =>      $portpassword
) || die "ERROR CREATING CLIENT: $@\n";

my $encrypt = $client->encryption();
my $compress = $client->compression();

my $socket = $client->socket();
my $sel    = new IO::Select($socket);

my $reply;

my $mw  = new MainWindow(-background => 'lightsteelblue');
my $rotext = $mw->Scrolled('ROText', -scrollbars=>'ose',
                           -background => 'black',
                           -foreground  => 'lightyellow',    
                         )->pack;

&displayit($rotext ,"encryption method ->$encrypt\ncompression method
->$compress\n");

my $ent = $mw->Entry()->pack(qw/-fill x -pady 5/);

$mw->Button(-text =>'Disconnect', 
            -command =>sub{$client->close();Tk::exit },
        -background => 'pink',
        -activebackground => 'hotpink',
           )->pack();

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

$reply = $client->receive() || die "ERROR RECEIVING: $@\n";
if($reply eq 'LOGIN'){ &logon }

$reply = $client->receive() || die "ERROR RECEIVING: $@\n";

$mw->repeat(11, sub {
    while($sel->can_read(.01)) {
    my $reply = $client->receive();
         &displayit($rotext, $reply);
        }
    }); 

                    
MainLoop;
##############################################################
sub broadcast {
    my ($ent, $client) = @_;

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

    $client->send($text);
}
##############################################################
sub displayit {
   my ($rotext,$data) = @_;
  
  $rotext->insert('end',$data);
  $rotext->see('end');               
}

###############################################################
sub logon{

# this section checks user and password
# it exits when an OK-SEND-> is received
while(1){
$hash{'user'} = $user;
$hash{'pass'} = $pass;

my $reply = &sendhash();
print "$reply\n";
if($reply =~ /^OK-SEND->(.*)/){last}
}

}
###############################################################
#################################################################
sub sendhash{
$client->send(\%hash) || die "ERROR SENDING: $@\n";
my $reply = $client->receive() || die "ERROR RECEIVING: $@\n";
return $reply;
}
################################################################ 
__END__
[download]