thanos1983 has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

On my code every time a new user connects to the server I am binding his port into a hash $hash{$port} = $text[1]; for future reference through the: $new_sock->peerport() process, I pick up the port number.

The moment that a new client will connect with the server this value will change, as expected, because $new_sock->peerport() is binded with $new_sock = $sock->accept(). The problem that I am having is that I can not find a way to separate the clients when they are communicating with the server.

Update:

The goal is to be able to change the name of the client who is sending a message to the server, so I can make a small function to send this message to all clients apart from him self.

Working sample of Server Code:

Update the Server code: 3 and Solution with minor problem (It sends the message to all clients, I am trying to fix this sending the message to all clients apart from the one who sends the message.)!

Update: 4 Final!

Final Update on Server and Client works perfect, based on my expectations. The code also controls terminating clients.

#!/usr/bin/perl
use utf8;
use strict;
use warnings;
use IO::Select;
use Data::Dumper;
use IO::Socket::INET; # Non-blocking I/O concept.
use constant ARGUMENTS => scalar 1;
use constant NICKNAME  => scalar 12;
use constant MAXBYTES  => scalar 255;

# flush memory after every initialization
$| = 1;

my $info = $ARGV[0]; # User message IP:PORT;
my $error = "ERROR";
my $newline = "\n";
my %hash = (); # global variable
my %children = ();
my %a_hash = ();
my @clients = ();
my ( $client_data , $server_sock , $buf , $sock , $msg , $new_sock , $
+trans , $readable_handles , $port , $kidpid , $s_hash , $client );

if (@ARGV > ARGUMENTS) {
    print "\nPlease no more than ".ARGUMENTS." input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:5000)\n";
    exit();
}
elsif (@ARGV < ARGUMENTS) {
    print "\nPlease no less than ".ARGUMENTS." input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:5000)\n";
    exit();
}
else {
    
    my $string = index($info, ':');

    if ($string == '-1') {
    die "Please include ':' in your input - ".$info."\n";
    }

    my @input = split( ':' , $info );

    $server_sock = new IO::Socket::INET( LocalAddr => $input[0],
                     LocalPort => $input[1],
                     Proto     => 'tcp',
                     Listen    => SOMAXCONN,
                     Reuse     => 1 ) or die "Could not connect: $!";

    print "\n[Server $0 accepting clients at PORT: ".$input[1]." and I
+P: ".$input[0]."]\n";

    $readable_handles = new IO::Select();
    $readable_handles->add($server_sock);

    while (1) {

    (my $new_readable) = IO::Select->select($readable_handles, undef, 
+undef, 0);
    # conver string to array @$new_readable
    foreach $sock (@$new_readable) {        
        # Check if sock is the same with server (e.g. 5000)
        # if same (new client) accept client socket
        # else read from socket input
        if ($sock == $server_sock) {
        $new_sock = $sock->accept()
            or die sprintf "ERROR (%d)(%s)(%d)(%s)", $!,$!,$^E,$^E;
        $readable_handles->add($new_sock);
        $trans = "Hello version";
        $client_data = &send($trans);
        print "First send: ".$client_data."\n";
        }
        else {
        $buf = <$sock>;
        $port = $sock->peerport();
        print "This is \$sock: ".$sock."\n";
        print "This is \$port: ".$port."\n";
        ($msg) = receive($buf);
        print "First receive: ".$msg."\n";
        my @text = split(/ / , $msg , 2); # LIMIT = 2 Only the first t
+wo gaps split
        #print Dumper(@text);
        if ($text[0] eq "NICK") {
            if (length($text[1]) > NICKNAME) {
            $trans = "".$error." Please no more than ".NICKNAME." char
+acters as nickname!";
            $client_data = &send($trans);
            $readable_handles->remove($sock);
            close($sock);            
            }
            elsif ($text[1] =~ s/\W//g) {
            $trans = "".$error." Special characters detected in the ni
+ckname, please remove them!";
            $client_data = &send($trans);            
            $readable_handles->remove($sock);
            close($sock);
            }
            else {
            $hash{$port}=$text[1];
            #push( @clients , $text[1] );
            #print Dumper(\@clients);
            $trans = "OK";
            $client_data = &send($trans);
            print "Second send: ".$client_data."\n";
            }
        } # End of if ($text[0] eq "NICK")
        elsif ($text[0] eq "MSG") {
            if (length($text[1]) > MAXBYTES) {
            $trans = "".$error." Please remember that message limit is
+ ".MAXBYTES."";
            $client_data = &send($trans);
            print "In case of message over ".MAXBYTES." send: ".$clien
+t_data."\n";
            }
            else {
            # Get all client(s) socket(s)
            my @sockets = $readable_handles->can_write();
            # Send the same message to client(s)
            print Dumper(\%hash);
            foreach my $sck (@sockets) {
                            my $final = "".$text[0]." ".$hash{$port}."
+ ".$text[1]."";
                utf8::encode($final);
                print $sck "".$final."".$newline."";
                print "Third send: ".$final."\n";
                #print STDOUT "The following data send to Client(s): (
+\ ".$buf." \)\n";
            } # End of foreach
            }
        } # End of elsif ($text[0] eq "MSG")
        else {
            print "Closing client!\n";
            # when the client disconnects
            delete $hash{$port};
            $readable_handles->remove($sock);
            close($sock);
        } # End of else condition
        } # End of else condition ($sock == $server_sock)
    } # End of foreach new sock
    } # End of While (1)

    print "Terminating Server\n";
    close $server_sock;
    getc();
} # End of else @ARGV

sub send {
    $_[0] = "".$_[0]."".$newline."";
    utf8::encode($_[0]);
    print $new_sock $_[0];
    chomp ($_[0]);
    #print "The following data send to Cliets: (\ ".$_[0]." \)\n";
    #$client_sock->send($client_packet,MAXBYTES);
    return $_[0];
}

sub receive {
    #$new_sock->recv($client_data,MAXBYTES);
    utf8::decode($_[0]);
    chomp ($_[0]);
    if($_[0] =~ /^$/) {
    print "Data packet received empty!\n";
    print "From host: ".$sock->peerhost()." and port: ".$sock->peerpor
+t()."\n";
    return $_[0];
    }
    elsif ($_[0] !~ /^$/) {
    #print STDOUT "The following data received from Client: (\ ".$buf.
+" \)\n";
    #print "From host: ".$sock->peerhost()." and port: ".$sock->peerpo
+rt()."\n";
    #return $_[0];
    return ($_[0]);
    }
    else {
    $error = "".$error."".$newline."";
    utf8::encode ($error);
    $server_sock->send($error);
    print "Invalid client: ".$new_sock->peerhost()." terminating!\n";
    $readable_handles->remove($sock);
    close($sock);
    }
}

[download]
Update 2, I added the client code for experimentation purposes: 
#!/usr/bin/perl
use utf8;
use strict;
use warnings;
use Data::Dumper;
use IO::Socket::INET;
use constant ARGUMENTS => scalar 2;
use constant NICKNAME => scalar 12;
use constant MAXBYTES => scalar 255;

# flush memory after every initialization
$| = 1;

my $info = $ARGV[0]; # User message argv[0]
my $Nickname = $ARGV[1]; # User nickname argv[1]
my ( $kidpid, $line , $client_sock , $server_data , $send );
my $error = 'ERROR';
my $newline = "\n";

if (@ARGV > ARGUMENTS) {
    print "\nPlease no more than ".ARGUMENTS." arguments (ARGV[])!\n";
    print "\nCorrect Syntax: perl $0 'IP:PORT  NICKNAME' (e.g. 127.0.0
+.1:5000 Thanos)\n\n";
    exit();
}
elsif (@ARGV < ARGUMENTS) {
    print "\nPlease no less than ".ARGUMENTS." arguments (ARGV[])\n";
    print "\nCorrect Syntax: perl $0 'IP:PORT  NICKNAME' (e.g. 127.0.0
+.1:5000 Thanos)\n\n";
    exit();
}
else {
    
    my $string = index($info, ':');

    if ($string == '-1') {
    die "Please add ':' in your input - ".$info."\n";
    }

    my @input = split( ':' , $info );

    # create a tcp connection to the specified host and port 
    $client_sock = IO::Socket::INET->new( Proto    => "tcp",
                      PeerAddr => $input[0],
                      PeerPort => $input[1] 
    ) or die "Can't connect to port ".$input[1]." at ".$input[0].": $!
+\n";

    $client_sock->autoflush(1);    # so output gets there right away 
    print STDERR "[Connected to ".$input[0].":".$input[1]."]\n";
    
    $line = <$client_sock>;
    my $receive = &receive($line);
    #print "First receive: ".$receive."\n";
    if ($receive eq "Hello version") {
    $Nickname = "NICK ".$Nickname."";
    $send = &send($Nickname);
    #print "First send: ".$Nickname."\n";
    $line = <$client_sock>;
    $receive = &receive($line);
    #print "Second receive: ".$receive."\n";
    if ($receive eq "OK") {
        # split the program into two processes, identical twins
        print "Client '".$ARGV[1]."' enter your text here:\n";
        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 = <$client_sock> ) ) {
            $receive = &receive($line);
            print "Third receive: ".$receive."\n";
            print "Client '".$ARGV[1]."' enter your text here:\n";
        } # End of While reading (parent)
        } # End of if (parent)
        # the else{} block runs only in the child process 
        else {
        # copy standard input to the socket 
        while ( defined( $line = <STDIN> ) ) {
            chomp ($line);
            my $line = "MSG ".$line."";
            $send = &send($line);
            if ($line =~ /quit|exit/i) {
            $line = "Client request ".$line."";
            my $send = &send($line);
            kill( "TERM", $kidpid );    # send SIGTERM to child 
            }
        } # End of read and send
        } # End of else child
    } # End of if (OK)
    else {
        print "Did not Receive OK!\n";
        exit();
    }
    } # End of if (Hello version)
    else {
    print "Did not receive Hello version!\n";
    exit();
    }
} # End of else @ARGV

sub send {
    $_[0] = "".$_[0]."".$newline."";
    utf8::encode($_[0]);
    print $client_sock $_[0];
    chomp($_[0]);
    #print "The following data send to Server: (\ ".$_[0]." \)\n";
    #$client_sock->send($client_packet,MAXBYTES);
    return $_[0];
}

sub receive {    
    # we can read from socket through recv()  in IO::Socket::INET
    #$client_sock->recv($server_data,MAXBYTES);
    utf8::decode($_[0]);
    chomp($_[0]);
    #print STDOUT "The following data received form Server: (\ ".$_[0]
+." \)\n";
    return $_[0];
}

[download]

I tried to retrieve the socket from two points: my @sockets = $readable_handles->can_write(); or $buf = <$sock>;. Since I this is the first server client that I am creating with the Select function I am not really familiar with it, and I can not find relative information to my problem online.

Any advice would be much appreciated. Thank you all for your time and effort assisting me with my problem.

Seeking for Perl wisdom...on the process...not there...yet!

Replies are listed 'Best First'.
Re: How to retrieve the port number on a Multiple TCP Chat Client Server
by Don Coyote (Hermit) on Jul 15, 2014 at 22:41 UTC

    Hi Thanos1983

    I have been looking at your server code, as I am learning about ipc and sockets. So I have not got a complete answer, but a few possible hints which I hope can help. The client code helped greatly.

    I cleaned up some of the newlines and concatanations so I could see what it is you were trying to do better. So here are some things that I spotted.

    Changing up the $readable_handles var may help. The IO::Select constructor returns a select object, which accesses the state of all the handles, whether they be Readable, Writeable, or Exceptions. Also the constructor auto adds any handles passed in.

    # $readable_handles = Select::IO->new();
# $readable_handles->add($server_sock);

  $select_object = Select::IO->new($server_sock);

    [download]

    The select::IO object extends the capabilities of the select function to act upon not only one, but stored arrays of, filehandles.

    The Example in the IO::Select documentation shows the while argument can actually be the call to read the ready select. Maybe this is something that you have already tried ?

    #while(1){
while(@readables = $select_object->can_read){

    [download]

    using the correct equality operator ? this could be a straight forward syntax error - as the equality operator earlier in the code is the double equals symbol ?

    # if( $sck eq $sock ){}
if( $sck == $sock ){}

    [download]

    This does not look as though it will do what you appear to attempt to be doing. You are trying to store messages to be sent in a hash queue keyed by the ports. But it looks like it will overwrite the message que in the hash, with a random message from the queue. the seed being the number of clients connected.

                else {
# store message in queue
            push( @clients , $text[1] );
#--> --^
# further down ...

            print Dumper(\@clients);
            $trans = "OK";
            $client_data = &send($trans);
            print "Second send: ".$client_data."\n";
            }
        } # End of if ($text[0] eq "NICK")
        elsif ($text[0] eq "MSG") {
            if (length($text[1]) > MAXBYTES) {
            $trans = "".$error." Please remember that message limit is
+ ".MAXBYTES."";
            $client_data = &send($trans);
            print "In case of message over ".MAXBYTES." send: ".$clien
+t_data."\n";
            }
            else {
            print "Second receive: ".$text[1]."\n";
            print "This is \$sock: ".$sock."\n";
            # Get all client(s) socket(s)
            my @sockets = $readable_handles->can_write();
            #my $count  = $readable_handles->count();

# store messages in hash ?
# for as many sockets that are readable, take the message 
# with the index of this this number, from the message 
# queue and replace the current hashed socket queue with 
# it. 
# that is, if 5 clients then each client will continue to 
# recieve the fifth messages from the message queue.
# or at least teh log will only record that, depending on 
# whr STDOUT

    for ($_ = 0; $_ < @sockets; $_++) {
          $hash{$sock} = $clients[$_];
            }
# or
     $hash{$sock} = 
        $clients[ scalar @{$select_object->can_write()} ]

    [download]

    Maybe this is some kind of buddy inviting incentive, get a freind to sign in and see the next message. idk...

    ok I think I can see what you are trying to do now.

    I cleaned up the server code a bit, including accessing the select 3 x ref to array in a ref to a array. But I tried to clear the fork out of the client (i am on wins rigth now) but that went wrong. so, so far I have...

    Also removed a fair bit of the if else constructs, was hard to see where the flow was going. Hopefully you can see some of the transitions, such as the double quoting interpolations. I think you will particularly like the dereference of the return array from the select call.

    #!/usr/bin/perl
use utf8;
use strict;
use warnings;
use IO::Select;
use Data::Dumper;
use IO::Socket::INET; # Non-blocking I/O concept.
use constant ARGUMENTS => scalar 1;
use constant NICKNAME  => scalar 12;
use constant MAXBYTES  => scalar 255;

# flush memory after every initialization
$| = 1;


my $error = "ERROR";

my %hash = (); # global variable

my ( $client_data  , $buf , $sock , $msg , $new_sock , $trans , $reada
+ble_handles , $client , $port );

unless (@ARGV == ARGUMENTS) {
    print "\nPlease only ARGUMENTS input!\n";
    print "Correct Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:5000)\n";
    exit();
}

 

# User message IP:PORT

 ( my ( $inputip, $inputport )  =

 ( $ARGV[0] =~ m/^(                     # $1  $inputip
                   (?:                  #non-capturing  
                       \d{1,3}\.        #1-3 digits followed by stop 
                    ){3}                #  x3
                    \d{1,3}             #last 1-3 digit of ip address 
                  )
                  :                     # colon
                  (\d+)                 # $2  $inputport 
               $/x ) );               # endmatch
 


print "::$inputip:-:$inputport:\n";

my $server_sock = IO::Socket::INET->new( 

  LocalAddr => $inputip,
  LocalPort => $inputport,
  Proto     => 'tcp',
  Listen    => SOMAXCONN,
  Reuse     => 1 

) or die "Could not connect: $!";

  print "\n[Server $0 accepting clients at IP: $inputip and PORT: $inp
+utport.]\n";

#   $readable_handles = IO::Select->new();

 my $select_object = IO::Select->new($server_sock); 

  while (1) {

       my @readables =  IO::Select->select($select_object, undef, unde
+f, 0) ;

    foreach $sock ( @{ $readables[0] } ) {    
    
        # Check if sock is the same with server (e.g. 5000)
        # if same (new client) accept client socket
        
        if ($sock == $server_sock) {

        $new_sock = $sock->accept()
            or die sprintf "ERROR (%d)(%s)(%d)(%s)", $!,$!,$^E,$^E;
    
              $select_object->add($new_sock);
                $trans = "Hello version";
                print { $new_sock } utf8::encode( $trans );
                print "First send: $trans\n";

        }else{

               # read from socket input

        $buf = <$sock>;
        my ($msg , $port) = receive($buf);

        my @text = split(/ / , $msg , 2); # LIMIT = 2 Only the first t
+wo gaps split

        #print Dumper(@text);

         if ($text[0] eq "NICK") {

            $hash{$port} = $text[1];
            print Dumper(\%hash);
            #print Dumper(\@names);

                $trans = "OK";
                    print { $sock } utf8::encode( $trans );
            print "Second send: $trans\n";
   
         }elsif ($text[0] eq "MSG") {

            print "Second receive: ".$text[1]."\n";

            # Get all client(s) socket(s)
            #my @names = values %hash;

            my @sockets = $select_object->can_write(); 

# possible problem ?
# none writeable - only 'select'ed readables                  writeabl
+e  ??
# (my $new_readable) = IO::Select->select($select_object,   undef,    
+   undef, 0);

            #print Dumper(\@sockets);
            # Send the same message to client(s)

            foreach my $sck (@sockets) {

                my $final = "$text[0] $hash{$port} $text[1] \n";
                utf8::encode($final);
                print { $sck } $final;
                print "Third send: $final";
                #print STDOUT "The following data send to Client(s): (
+\ ".$buf." \)\n";
            } 

         }else{
            print "Closing client!\n";
            # when the client disconnects
            delete $hash{$port};
            $select_object->remove($sock);
            close($sock);
         } 

        } # End of else condition ($sock == $server_sock)

    } # End of foreach $sock @readables

    } # End of While (1)

print "Terminating Server\n";
close $server_sock;
getc();




sub send {
    
    utf8::encode( $_[0] );

    print { $new_sock } $_[0],"\n"; 

#    chomp ($_[0]); # ? chomp encoded line?

    #print "The following data send to Clients: (\ ".$_[0]." \)\n";
    #$client_sock->send($client_packet,MAXBYTES);

    return $_[0];
}


sub receive {
    #$new_sock->recv($client_data,MAXBYTES);
    my $datarecieved = utf8::decode($_[0]);

    # assign $1 to $shortdata may need correcting.
    my( $shortdata ) = ( m/^(.{0,20})/ =~ $datarecieved ); 

    my( $phost, $pport ) = ( $new_sock->peerhost(), $new_sock->peerpor
+t() );
    my $fromhostport = "From host: $phost and port: $pport";

    print "This:$shortdata\n$fromhostport\n";

    return( $datarecieved, $pport );
    
    #(?) should not get here...

    utf8::encode (qq{ $error, \n } );
    $server_sock->send($error);
    print "Invalid client: $phost : terminating!\n";
    $select_object->remove($sock);
    close($sock);
    
}

    [download]

    please do post up any questions, and let me know if anything I suggested is of any help, or completely no good. Well, I have not got this one at all, I run this and I am getting binary output onto buffers.

    DoC

[reply]
[d/l]
[select]

      Hello Don Coyote,

      I appreciate the time and effort that you spend debugging my code and trying to help me. To be 100% honest I manage to solve it completely last night. After maybe 13 different ways of solving it, I got the output that I wanted.

      I am updating the server code now, just in case that you are curious execute it to see the output.

      Again thank you for time and effort I was lost for a long time because for me it was also the first server that I created.

      BR Thanos

      Seeking for Perl wisdom...on the process...not there...yet!
[reply]
[d/l]

Back to Seekers of Perl Wisdom