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

Don Coyote's scratchpad

by Don Coyote (Monk)
on Jul 01, 2010 at 17:29 UTC ( #847567=scratchpad: print w/ replies, xml ) Need Help??

Hi Thanos1983

I have been looking at your server code, as I am becoming more familiar with sockets. The client code helped greatly.

Alarming lack of localised lexicals...
(our) $newline = "\n" ...
yada, yada, yada

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);

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

Given select returns an indication of whether the filehandle is ready to be read from or written to,... ? fcntl block within a local scope within which can_write is called on the select object again ?

The Example in the IO::Select documentation shows the while argument can actually be the call to read the ready select.

#while(1){ while(@readables = $select_object->can_read){ foreach my $sock ( }

using the correct equality operator ?

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

wtf - recommend a friend.

else { # wtf part a 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 { 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(); # wtf part b # for as many sockets that are readable, take the message with the ind +ex of this this number, from the message queue and replace the curren +t #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 #how the mess +age is processed. for ($_ = 0; $_ < @sockets; $_++) { $hash{$sock} = $clients[$_]; } # or $hash{$sock} = $clients[ scalar @{$select_object->can_write()} ]

so you see - until you get your new buddy to sign in, you dont get to see the next message anyone sent. Also - you only get to say one thing ever.?

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...

#!/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(); } my $tmpv = $ARGV[0]; # User message IP:PORT #print "$ARGV[0] \n"; ( 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); }

previously was this, but the regex didnt work n stuff

#!/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; #change#4 remove $info assignment to after input validation/untaint. my $error = "ERROR"; my %hash = (); # global variable my ( $client_data , $server_sock , $buf , $sock , $msg , $new_sock , $ +trans , $readable_handles , $client , $port ); #change#1 tidy up if else - only one argument required - the addr:port unless (@ARGV == ARGUMENTS) { print "\nPlease only ".ARGUMENTS." input!\n"; print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:5000)\n"; exit(); } #change#2 - unneccessary else block removed. #change#3 - simple regex untaint. #change#(4) directly assign untainted data to ip/port vars. # User message IP:PORT my ( $inputip, $inputport ) = ( $ARGV[0] =~ m/^( #$1 / $inputip (?: #non-capturing \d{1-3}\. #1-3 digits followed by stop ){3} # x 3 \d{1-3} #last 1-3 digit of ip address ) : # colon (\d+) #$2 / $inputport $/x # endmatch ); $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 +: ".$inputport."]\n"; # $readable_handles = IO::Select->new(); $select_object = IO::Select->new($server_sock); while (1) { # ok we are listening ? # hmmm select RBIT by method, on blessed array ref of sockets. ok ? # or returns array ref of rbit set sockets ? # sets or gets readables ? my @readables = @{ IO::Select->select($select_object, undef, undef +, 0) }; foreach $sock ( @readables ) { # 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\n"; print { $new_sock } utf8::encode( $trans ); print "First send: $trans"; }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\n"; print { $sock } utf8::encode( $trans ); print "Second send: $trans"; }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]. +""; utf8::encode($final); print { $sck } "".$final."".$newline.""; print "Third send: ".$final."\n"; #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 new sock } # End of While (1) print "Terminating Server\n"; close $server_sock; getc(); } # End of else @ARGV 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); }

chdir `pwd`

doh!


Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (6)
As of 2014-09-21 11:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (168 votes), past polls