http://www.perlmonks.org?node_id=309126

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

FIRST OFF, BEFORE ANYTHING ELSE: THIS CODE SEEMS TO CONSUME A LOT OF MEMORY VERY QUICKLY... THOUGH I CANNOT TELL WHY... YET... CAUTION ADVISED

Ok, with that out of the way, I'll explain my problem. I'm trying to design a Client/Server pair... the client is designed in Java whereas the server is in POE, but the Java aspect is irrelivant at the moment. When the code is executed, it creates a server which awaits a connection from a client of some sort.

I know that in general it works, I have been able to connect to the server with TelNet and get the expected greeting, though two-way communication through telnet is impractical (or can someone tell me how to type the null char in Windows?) I have created a client in Perl after having my testing attempts thwarted from Java... unfortunately the Perl client is having the same problem... which in turn points at the server as the ultimate source.

This is a POE::Component::Server::TCP server, I created the Perl test-client using the corresponding POE::Component::Client::TCP. I do use two custom filters, one of which only bypasses a Server::TCP and Filter::Stackable incompatability without affecting the data itself.

Explanation of the failure: When running the server and a client other than TelNet, (in the case of Java, the read() never returns... no input events are fired in the case of the Perl client) memory is rapidly consumed with no sign of stopping. Once the client has made a conneciton attempt (if it isn't TelNet) the server also ignores CTRL-X/C.

I know I'm not really describing this as well as I should. I'm half asleep... 2:30 AM my time... so I'll gladly clarify anything I said that didn't make sense. Below is the code in question. Some lines will need to be commented out I imagine. Also, this entire project is my attempt at taking the Japanese CCG "Yu-Gi-Oh!" and porting it to the virtual world. I know Konami and UpperDeck may protest this so I have no real ambition at releasing it... for the most part this is a project to prove to myself I can do it.

Server Core:
#!perl use POE qw(Component::Server::TCP Filter::Stackable Filter::Block); use YuGiOh::Filter; use YuGiOh::Filter::Stackable; #use YuGiOh::Constants; #For the sake of posting it on PerlMonks, I'll + just dump any important constants below use Digest::MD5; use constant { PORT => 1001, ACCEPT => 1, FAIL => 0, MSG_SPEC => 2, MSG_ANNOUNCE => 3, MSG_LOGIN => 4, MSG_CHATSND => 5, MSG_PRIVSND => 6, #UIDOFTARGET followed by MESSAGE, when resen +t, replaced with UIDOFSENDER and MESSAGE MSG_CHATLIST => 7, #UIDName resends to increase list MSG_LEFTCHAT => 8, #UID MSG_REFRESH => 9, #Message field is ignored #Syntax for initiated challenge, replies the reverse, check vs a st +ored challenge list. MSG_CHALLENGE => 10, #UID TO CHALLENGE MSG_CHLCANCEL => 11, #Greeting MSG_GREETING => 28, }; use vars qw(%users @chars $slt); #$slt should not be referenced outside of the salt function, declared +here for memory allocation optimization use strict; @chars = ( 0 .. 9, 'a' .. 'z', 'A' .. 'Z', '#', ',', qw(~ ! @ $ % ^ & * ( ) _ + = - { } | : " < > ? / . ' ; ] [ \ `)); $slt = ' ' x 1000; #Used for including nested messages POE::Component::Server::TCP->new( Alias => 'master', Port => PORT, InlineStates => { 'send' => \&handle_send, #Events MSG_LOGIN => \&e_login, MSG_CHATSND => \&e_chat, MSG_PRIVSND => \&e_pchat, MSG_REFRESH => \&e_rfrsh, }, ClientConnected => \&client_connected, ClientError => \&client_error, ClientDisconnected => \&client_disconnected, ClientInput => \&client_input, ClientFilter => ['YuGiOh::Filter::Stackable', Filters => ['PO +E::Filter::Block','YuGiOh::Filter']], ); $poe_kernel->run(); exit 0; #Server related functions sub handle_send{ #my ($heap,$message) = @_[HEAP,ARG0]; warn("Sending!"); #Debugging message $_[HEAP]->{client}->put(@_[ARG0..$#_]); warn("Sent!"); #$heap->{client}->put($message); } sub client_connected { my $id = $_[SESSION]->ID; my $ary = []; $ary->[CHAL_BY] = []; $users{$id} = $ary; warn("$id conected!"); $poe_kernel->post($id, 'send' => [MSG_GREETING,$ary->[SALT] = salt( +)]); } sub client_error { $_[KERNEL]->yield("shutdown"); } sub client_disconnected { my $id = $_[SESSION]->ID; print "$id disconnected\n"; #Clean up other user's challenges foreach my $usr (@{ $users{$id}[CHAL_BY] }){ $users{$usr}[CHALLENGED] = ''; } delete($users{$id}); broadcast([MSG_LEFTCHAT,$id]); } sub client_input { my($id,$input) = ($_[SESSION]->ID,$_[ARG0]); #Ensure that the version has been sent warn("Input: $input"); unless($users{$id}[VERSION] || $input->[0] == MSG_GREETING){ #If this is ever called, assume they are cheating us... $poe_kernel->post($id, send => passfail(FAIL,$input,'Invalid Cal +l and Response')); $poe_kernel->post($id,'shutdown'); } } #Utility Functions #Pass this the original message[,error text] sub broadcast { foreach my $id (keys %users){ $poe_kernel->post($id,send => $_[0]); } } #Forces login, returns false when not logged in and broadcasts not log +ged in error sub login{ my $id = $_[0][SESSION]->ID; if($users{$id}){ return 1; }else{ $_[SESSION]->yield([FAIL,passfail($_[ARG0],'User not logged in!' +)]); return; } } sub passfail { return [$_[0],sprintf('%03d',$_[1][0]).$_[2]]; } sub salt { my $len = int(rand(1000)); $slt = ''; for(1..$len){ $slt .= $chars[int(rand($#chars))]; } return $slt; } #Events sub e_challenge { my($id,$targ) = ($_[SESSION]->ID,$_[ARG0][1]); return unless(login(\@_)); unless($users{$targ}){ $_[SESSION]->yield('send' => [FAIL,passfail($_[ARG0],'Unable to +locate target.')]); return; } $_[SESSION]->yield('send' => [ACCEPT,passfail($_[ARG0])]); my $usr = $users{$id}; if($usr->[CHALLENGED]){ $poe_kernel->post($usr->[CHALLENGED], 'send' => [MSG_CHLCANCEL,$ +id]); } if($users{$targ}[CHALLENGED] == $id){ #Battle Time }else{ $usr->[CHALLENGED] = $targ; push(@{ $users{$targ}[CHAL_BY] },$id); $poe_kernel->post($id, 'send' => [MSG_CHALLENGE,$id]); } } sub e_chat { my($id,$text) = ($_[SESSION]->ID,$_[ARG0][1]); return unless(login(\@_)); broadcast([MSG_CHATSND,$id."\0".$text]); $_[SESSION]->yield('send' => [ACCEPT,passfail($_[ARG0])]); } sub e_login { my($id,$text) = ($_[SESSION]->ID,$_[ARG0][1]); warn(); my($login,$pass) = split(/\0/,$text,1); #do db lookup & pass comparison $users{$id}[NAME] = $login; #Remember to set UID $_[SESSION]->yield('send' => [ACCEPT,passfail($_[ARG0],$id)]); #As +sume sucess until database finalized broadcast([MSG_CHATLIST,$id."\0".$login]); $_[SESSION]->yield(MSG_REFRESH); } sub e_pchat { my($id,$txt) = ($_[SESSION]->ID,$_[ARG0][1]); return unless(login(\@_)); my($dest,$msg) = split(/\0/,$txt,1); if($users{int($dest)}){ $poe_kernel->post($dest, 'send' => [MSG_PRIVSND,$id."\0".$msg]); $_[SESSION]->yield('send' => [ACCEPT,passfail($_[ARG0])]); }else{ $poe_kernel->yield('send' => [FAIL,passfail($_[ARG0],'Unable to +locate destination user.')]); } } sub e_rfrsh { my $s = $_[SESSION]; #might want to check for login... but... #Might want to re-implement this so this array-ref is a const, rath +er than re-create each time $s->yield('send',[MSG_REFRESH],map({ [MSG_CHATLIST,$_."\0".$users{$ +_}[NAME]] } keys(%users))); } sub e_version { my($id,$version) = ($_[SESSION]->ID,$_[ARG0][1]); warn(); #Compare with newest acceptable version, possibly alerting that a n +ewer version is available $users{$id}[VERSION] = $version; #Why we store it I don't know... +yet... if I can't find a reason I'll make it a bool $_[SESSION]->yield('send' => [ACCEPT,passfail($_[ARG0])]); }


YuGiOh/Filter.pm
package YuGiOh::Filter; use Data::Dumper; use strict; #THIS FILTER SHOULD ONLY BE USED WHEN CHAINED WITH THE BLOCK FILTER TH +ROUGH THE STACKABLE FILTER sub new { my $self = []; return bless($self,'YuGiOh::Filter'); } sub get { my $self = shift; $self->get_one_start(@_); #Append needed/available info my @list; while(my $record = $self->parse()){ push(@list,$record); } return \@list; } sub get_one_start { push(@{$_[0]},@{$_[1]}); } sub get_one { my $self = shift; my $record = $self->parse(); return $record ? [$record] : []; } sub parse { my $self = shift; my $txt = shift(@$self); return [substr($txt,0,3,''),$txt]; } sub put { #warn("In the custom put"); my $tmp = [map({ sprintf('%03d',$_->[0]).$_->[1] } @{$_[1]})]; #print Dumper($tmp); return $tmp; } sub get_pending { return [ @{$_[0]} ]; } 1;


YuGiOh/Filter/Stackable.pm
package YuGiOh::Filter::Stackable; use base 'POE::Filter::Stackable'; use strict; sub new { my $type = shift; my %param = @_; my $list = []; if($param{Filters}){ foreach my $filter (@{$param{Filters}}){ push(@$list,ref($filter) ? $filter : $filter->new()); } } $type->SUPER::new(Filters => $list); } 1;


Client:
#!perl use POE qw(Component::Client::TCP Filter::Stackable Filter::Block); use YuGiOh::Filter; #use YuGiOh::Constants; use Digest::MD5; use Data::Dumper; use constant { PORT => 1001, }; POE::Component::Client::TCP->new ( RemoteAddress => '192.168.1.11', RemotePort => PORT, ConnectTimeout => 5, # Seconds; optional. #Started => \&handle_starting, # Optional. #Args => [ "arg0", "arg1" ], # Optional. Started args. #Connected => \&handle_connect, #ConnectError => \&handle_connect_error, #Disconnected => \&handle_disconnect, ServerInput => \&handle_server_input, #ServerError => \&handle_server_error, #ServerFlushed => \&handle_server_flush, Filter => ["POE::Filter::Stackable", Filters => [new POE::F +ilter::Block(),new YuGiOh::Filter()]], ); $poe_kernel->run(); sub handle_server_input { my($session,$message) = ($_[SESSION],$_[ARG0]); print Dumper($message); }

As can be seen, the client isn't very complicated... It was designed to simply prove to myself that the server was communicating sucessfully... which it doesn't seem to do... I'm open to suggestions beyond my immediate problem if anyone has any. Thanks for taking the time to look at this... I know it's a rather long post and it's not written too clearly.





My code doesn't have bugs, it just develops random features.

Flame

Replies are listed 'Best First'.
Re: POE Client/Server pairs
by Flame (Deacon) on Nov 24, 2003 at 03:12 UTC

    My thanks to revdiablo for his suggestion that I compress the code in the hopes of getting someone to reply. I found it in the process... (/me feels really stupid)

    First off, let's review what is "true" in perl.

    • 1
    • " "
    • "this"
    • "that"
    • "I feel stupid"

    And, of course, there are those things that everyone forgets now and then... and then kicks themselves repeatedly when they notice it. For example: [] is true. So is {}. After all, it's holding a non-zero value... my trouble serves me right for that little while loop in the get() function of the YuGiOh::Filter package. Once repaired, everything started working...

    Well, thanks to everyone who at least tried to help, may we all walk away with a good lesson.





    My code doesn't have bugs, it just develops random features.

    Flame