Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??


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

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;

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;

#!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 => '', 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.


In reply to POE Client/Server pairs by Flame

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (1)
    As of 2018-02-23 01:07 GMT
    Find Nodes?
      Voting Booth?
      When it is dark outside I am happiest to see ...

      Results (300 votes). Check out past polls.