Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Questions with a TCP stream protocol (POE, code)

by deprecated (Priest)
on Dec 16, 2001 at 04:54 UTC ( #132281=perlquestion: print w/ replies, xml ) Need Help??
deprecated has asked for the wisdom of the Perl Monks concerning the following question:

I've written a module to communicate with servers that use a sort of "little endian" communication protocol. The format of the messages is:
XXYYmessage
where XX is a little-endian two-byte message indicating the length of the message (without XXYY), and YY is an 'event code' such as 403 (public message). XX and YY are generally unrepresentable in plain text beacause they are lower than 'a'.

The module works for the first message. This is generally a login message. Also, the method I use for talking _back to_ the client is working.

The module is below:

package POE::Filter::LittleEndian; use strict; use warnings; use Carp qw{ croak carp cluck }; use constant FRAMING_BUFFER => 0; use constant EXPECTED_SIZE => 1; use constant EVENT_CODE => 2; #--------------------------------------------------------------------- +--------- sub new { my $type = shift; if (@_) { carp "POE::Filter::LittleEndian does not support any arg +uments!\n" } my $self = bless [ '', undef, undef, ], $type; $self; } #--------------------------------------------------------------------- +--------- sub get { my ($self, $stream) = @_; my @blocks; $self->[FRAMING_BUFFER] .= join '', @{$stream}; # we know what to expect, size wise if ( defined $self -> [EXPECTED_SIZE] ) { # if the length of the buffer is less than we had hoped for, e +xit. last if (length $self -> [FRAMING_BUFFER] < $self -> [EXPECTED +_SIZE]); # read in as much as we can my $chunk = substr($self -> [FRAMING_BUFFER], 0, $self -> [EXP +ECTED_SIZE]); # and then zap it, because we've read it. substr($self -> [FRAMING_BUFFER], 0, $self -> [EXPECTED_SIZE]) + = ''; # and now we need another LENGTH block so we zap this one... undef $self -> [EXPECTED_SIZE]; # and return to caller. push @blocks, $chunk; } # we dont know what to expect, this is a new packet. else { my $little_e = $self -> [FRAMING_BUFFER]; my ($length, $event) = unpack 'vv', $little_e; my $body; # tell our hackers what event they had. $self -> [EVENT_CODE] = $event; # lop off the event code and the length, the hacker has it in +the object. if ($length and (length $little_e >= 4 + $length)) { $body = substr($little_e, 4, $length); } $self -> [FRAMING_BUFFER] = $body; $self -> [EXPECTED_SIZE] = $length; } return \@blocks; } #--------------------------------------------------------------------- +--------- # 2001-07-27 RCC: The get_one() variant of get() allows Wheel::Xyz to # retrieve one filtered block at a time. This is necessary for filter # changing and proper input flow control. sub get_one_start { my ($self, $stream) = @_; $self->[FRAMING_BUFFER] .= join '', @$stream; } sub get_one { my $self = shift; if ( defined $self -> [EXPECTED_SIZE] ) { return [ ] if length($self->[FRAMING_BUFFER]) < $self->[EXPECT +ED_SIZE]; my $block = substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTE +D_SIZE]); substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]) = ' +'; undef $self->[EXPECTED_SIZE]; return [ $block ]; } else { my $little_e = $self -> [FRAMING_BUFFER]; my ($length, $event) = unpack 'vv', $little_e; return [ ] unless ($length and $event); my $body; $self -> [EXPECTED_SIZE] = $length; if ($length and (length $little_e >= 4 + $length)) { $body = substr($little_e, 4, $length); } $self -> [EVENT_CODE] = $event; $self -> [FRAMING_BUFFER] = $body; return [ ] if length($self->[FRAMING_BUFFER]) < $self->[EXPECT +ED_SIZE]; my $block = substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTE +D_SIZE]); substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]) = ' +'; undef $self->[EXPECTED_SIZE]; return [ $block ]; } return [ ]; # not sure why we'd get here, but best to be safe... } #--------------------------------------------------------------------- +--------- sub put { my ($self, $blocks) = (@_); return $blocks; } #--------------------------------------------------------------------- +--------- sub get_pending { my $self = shift; return undef unless length $self->[FRAMING_BUFFER]; return [ $self->[FRAMING_BUFFER] ]; } ###################################################################### +######### 1; __END__
You may notice that this is loosely based on POE::Filter::Block.

Basically, I've incorporated some of the methods from MP3::Napster, which also uses the protocol, and the aforementioned POE filter.

I think what's happening is I am inadvertently clobbering the [EXPECTED_SIZE] attribute of the object. I feel like I have a very good understanding of the code, and see what it's doing, but I cant seem to figure out where I am messing it up.

I have this great 'hexdump' code which converter graciously gave me, and I can see that in the middle of the next messages, there are 'overflows' of one message into the other with the little-endian bytes at the front.

I'd really appreciate it if somebody <!- except tilly of course -> could take a look at this for me, and see if there's something that doesnt add up.

--
Laziness, Impatience, Hubris, and Generosity.

Comment on Questions with a TCP stream protocol (POE, code)
Select or Download Code
Re: Questions with a TCP stream protocol (POE, code)
by chromatic (Archbishop) on Dec 16, 2001 at 07:14 UTC
    In this code snippet:
    # lop off the event code and the length, the hacker has it in the obje +ct. if ($length and (length $little_e >= 4 + $length)) { $body = substr($little_e, 4, $length);
    Do you actually mean:

    $body = substr($little_e, 4, $length, '');

    The substr earlier looks a little suspicious, too. I'd use the four argument form in both places.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (12)
As of 2014-10-01 21:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (40 votes), past polls