Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

how to control segmented messages in TCP chat client

by thanos1983 (Parson)
on Aug 24, 2014 at 01:48 UTC ( [id://1098437]=perlquestion: print w/replies, xml ) Need Help??

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

Dear monks,

I have created a multiple client server with TCP sockets. I having difficulties to figure out how to control the cases where segmentation while occur. I am using specific buffered memory while receiving messages, so in case that the user will exceed this memory the msg will be split in pieces. The pieces will be transmitted sequentially because of the TCP protocol and will be received by the receiver. So my question is how to construct the message when it is received segmented?

I know the receive function Perl accepts only a specific memory to store the data $memory, I was thinking that I could use an @array but I can not apply it. So the next option was to push(@array,$receive) and then apply $string = join(' ' , @array) in order to reconstruct the string just like the user typed it.

As an idea sounds good but no matter how many times with different strategies I tried I failed. Because I noticed that for each message the receive function will send the string that it received segmented and not complete in order to receive the next one.

So the question is how to force the receiver to wait to receive all the pieces together before exits the loop?

Update-2 on Server.pl with (partial solution)

Well I did not manage to find a way to combine the segmented messages. Because I observed that the message are arriving separately and they are not combined automatically after. So I decided to send to the client the parts that can not be send on the transmission. Based on the condition that I have if message received greater than MAX_BYTES that the user can define send the segmented part back to him. I know it is not a correct solution but it is than before that the client was not aware.

Working code Server.pl for testing purposes.

#!/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 TRUE => scalar 1; use constant ARGUMENTS => scalar 1; use constant NICKNAME => scalar 12; use constant MAXBYTES => scalar 15; # 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 @clients = (); my ( $client_data , $server_sock , $sock , $new_sock , $trans , $reada +ble_handles , $port , $kidpid , $data , $msg , $string); if (@ARGV > ARGUMENTS) { print "\nPlease no more than ".ARGUMENTS." argument 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." argument 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 (TRUE) { (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,$new_sock); print "First send: ".$client_data."\n"; } else { $port = $sock->peerport(); print "This is \$sock: ".$sock."\n"; print "This is \$port: ".$port."\n"; $msg = receive($sock); 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,$sock); $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,$sock); $readable_handles->remove($sock); close($sock); } else { $hash{$port}=$text[1]; $trans = "OK"; $client_data = &send($trans,$sock); 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." bytes, this is the rest of the segmented message: ".$te +xt[1].""; $client_data = &send($trans,$sock); 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]."'"; &send($final,$sck); #print STDOUT "The following data send to Client(s): ( +\ ".$final." \)\n"; } # End of foreach } } # End of elsif ($text[0] eq "MSG") else { print "Closing client '".$hash{$port}."'!\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 { chomp($_[0]); $_[0] = "".$_[0]."".$newline.""; utf8::encode($_[0]); $_[1]->send($_[0]); chomp ($_[0]); #print "The following data send to Cliets: (\ ".$_[0]." \)\n"; return $_[0]; } sub receive { my @array = (); $_[0]->recv($data , MAXBYTES); print "Length of received: ".length($data)."\n"; utf8::decode($data); chomp ($data); # In case of terminating message Client will send Client request M +SG (exit or quit) but we can use only the Client part if ($data !~ /^MSG|NICK|Client/i) { $data = "MSG " . "Segmended message: " . "".$data.""; } if($data =~ /^$/) { print "Data packet received empty!\n"; print "From host: ".$_[0]->peerhost()." and port: ".$_[0]->peerpor +t()."\n"; $data = "MSG Server received empty packet from ".$_[0]->peerhost." +!"; return $data; } elsif ($data !~ /^$/) { #print STDOUT "The following data received from Client: (\ ".$data +." \)\n"; #print "From host: ".$sock->peerhost()." and port: ".$sock->peerpo +rt()."\n"; return $data; } 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); } }
Update on Client.pl

Thanks to Athanasius for his valuable observation I modify the $_[0] to $data and define it at the begging of the script also.

Working code Client.pl for testing 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; use constant MAX_PORT => scalar 65536; use constant MIN_PORT => scalar 1; # 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 , $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 ); if ( ($input[1] > MAX_PORT) || ($input[1] < MIN_PORT) ) { print "\nPlease use port number between ".MIN_PORT." - ".MAX_PORT. +"\n\n"; exit(); } # 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_msg = receive(); if ($receive_msg eq "Hello version") { $Nickname = "NICK ".$Nickname.""; $send = &send($Nickname); $receive_msg = receive(); if ($receive_msg eq "OK") { # 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( $receive_msg = receive() ) ) { print "Third receive: ".$receive_msg."\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 { print "Please note that maximum characters are ".MAXBYTES."\ +n"; print "Client '".$ARGV[1]."' enter your text here:\n"; # copy standard input to the socket while ( defined( chomp($line = <STDIN>) ) ) { my $line = "MSG ".$line.""; if ($line =~ /quit|exit/i) { $line = "Client request ".$line.""; print "".$line."\n"; my $send = &send($line); kill( "TERM", $kidpid ); # send SIGTERM to child } $send = &send($line); } # 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 { chomp($_[0]); $_[0] = "".$_[0]."".$newline.""; utf8::encode($_[0]); $client_sock->send($_[0]); chomp($_[0]); #print "The following data send to Server: (\ ".$_[0]." \)\n"; return $_[0]; } sub receive { # we can read from socket through recv() in IO::Socket::INET $client_sock->recv($data , MAXBYTES); utf8::decode($data); chomp($data); #print STDOUT "The following data received form Server: (\ ".$_[0] +." \)\n"; return $data; }

Any help or advice is greatly appreciated.

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

Replies are listed 'Best First'.
Re: how to control segmented messages in TCP chat client
by Athanasius (Archbishop) on Aug 24, 2014 at 03:39 UTC

    Hello thanos1983,

    This is not an answer to your question, just an observation on one part of the code.

    In Client.pl there is a subroutine sub receive which references $_[0], i.e. the first argument passed into the sub. This subroutine is called three times within Client.pl, each time like this:

    $receive_msg = receive()

    with no arguments passed in. So $_[0] is in all cases uninitialised, and the sub call accomplishes nothing.

    Hope that helps,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

      Hello Athanasius,

      Thank you for the observation, I was modifying the code earlier from a previous version and this part I forgot to change. :D

      But maybe is also the source of some other problems that I had. You gave me food for thought. I need to experiment more with code, maybe I am able to figure out the problem.

      Again thank you for your time and effort to assist me.

      Seeking for Perl wisdom...on the process of learning...not there...yet!
Re: how to control segmented messages in TCP chat client
by Anonymous Monk on Aug 25, 2014 at 01:53 UTC

    TCP is a stream-oriented protocol. Message boundaries are lost and fragmentation may occur at any time. It is useful to frame your data, ie establish a protocol layer on top of TCP.

    A simple way to accomplish this is by prefixing your messages with their length: my $pkt = pack "n/a", $str; but line-based protocols are also common. Using readline could be tricky, though.

    In any case, you'll want to buffer the stream. When a message is complete, rip it/them out of the buffer (unpack or split) and fire the message handler. Callback-driven logic will help you arrive at a clean, modular solution.

      Hello Anonymous Monk

      To be honest after so many different approaches, I came with another possible solution to yours but I do not know if many people will think it is a good option or not. I decided not to implemented due strict documentation prerequisites but I think it could work.

      In case that someone was facing a similar problem he could apply use bytes; and then no bytes;, official documentation bytes or length official documentation length. By doing so the user can get the size in bytes for the message that he wants to transmit, or the length of the message that he wants to transmit. Either way he can create a message containing the length to expect as a number or the size (Caution the user needs to subtract the size of the number after) and simple create a condition to collect all the messages together. Such as while ($msg_size != $msg) {}. This is of course a sample, but I think the idea after some experimentation can be applied.

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

        thanos1983,

          (Caution the user needs to subtract the size of the number after)

        You need to read the 4 byte size in order to know how many bytes to read. So don't subtract or you will lose the last 4 bytes of the message.

        Regards...Ed

        "Well done is better than well said." - Benjamin Franklin

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1098437]
Approved by NetWallah
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2024-04-24 02:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found