root/POE-Component-Client-MSN/trunk/lib/POE/Filter/MSN.pm

Revision 961 (checked in by xantus, 17 years ago)

lots of changes, MSFTP added, filter works correctly now

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package POE::Filter::MSN;
2 use strict;
3
4 use POE qw(Component::Client::MSN::Command);
5
6 use vars qw($Debug);
7 $Debug = 0;
8
9 sub Dumper { require Data::Dumper; local $Data::Dumper::Indent = 1; Data::Dumper::Dumper(@_) }
10
11 sub new {
12     my $class = shift;
13         my %opts = @_;
14         my $o = {
15                 buffer => '',
16                 get_state => 'line',
17                 body_info => {},
18                 ftp => 0,
19     };
20         foreach (keys %opts) {
21                 $o->{$_} = $opts{$_};
22         }
23         bless($o, $class);
24 }
25
26 sub get {
27         my ($self, $stream) = @_;
28
29         # Accumulate data in a framing buffer.
30         $self->{buffer} .= join('', @$stream);
31
32        
33         my $many = [];
34         while (1) {
35                 my $input = $self->get_one([]);
36                 if ($input) {
37                         push(@$many,@$input);
38                 } else {
39                         last;
40                 }
41         }
42
43         return $many;
44 }
45
46 sub get_one_start {
47         my ($self, $stream) = @_;
48
49         $Debug && do {
50                 open(FH,">>/tmp/proto.log");
51                 print FH join('', @$stream);
52                 close(FH);
53         };
54         # Accumulate data in a framing buffer.
55         $self->{buffer} .= join('', @$stream);
56 }
57
58 sub get_one {
59     my($self, $stream) = @_;
60        
61     return [] if ($self->{finish});
62        
63     my @commands;
64     if ($self->{get_state} eq 'line') {
65                 return [] unless($self->{buffer} =~ m/\r\n/s);
66
67                 while (1) {
68 #                       warn "buffer length is".length($self->{buffer})."\n";
69                         if ($self->{buffer} =~ s/^(.{3}) (?:(\d+) )?(.*?)\r\n//) {
70 #                               print STDERR "got [$1] [$2] [$3]\n";
71                                 #while ($self->{buffer} =~ s/^(.{3}) (?:(\d+) )?(.*?)\r\n//){
72                                 my $command =  POE::Component::Client::MSN::Command->new($1, $3, $2);
73                         if ($command->name eq 'MSG') {
74                                         # switch to body
75                                         $self->{get_state} = 'body';
76                                         $self->{body_info} = {
77                                             command => $command,
78                                             length  => $command->args->[2],
79                                         };
80                                         last;
81                             } elsif ($command->name eq 'FIL') {
82                                         # switch to body
83                                         $command->name("file_data_stream");
84                                         $self->{body_info} = {
85                                             command => $command,
86                                             file_length  => $command->data,
87                                                 bytes_read => 0,
88                                                 total_bytes_read => 0,
89                                         };
90 #                                       print STDERR "file len: ".$command->data."\n";
91                                         push @commands, $command;
92                                         return \@commands;     
93                                 } else {
94                                         push @commands, $command;
95                             }
96                         } else {
97                                 #return [];
98                                 last;
99                         }
100                 }
101     }
102
103     if ($self->{get_state} eq 'body') {
104                 if (length($self->{buffer}) < $self->{body_info}->{length}) {
105                     # not enough bytes
106                     $Debug and warn Dumper \@commands;
107                         return \@commands;
108                 }
109                 my $message = substr($self->{buffer}, 0, $self->{body_info}->{length}, '');
110                 my $command = $self->{body_info}->{command};
111                 $command->message($message);
112                 push @commands, $command;
113        
114                 # switch to line by line
115                 $self->{get_state} = 'line';
116         $Debug and warn "GET: ", Dumper \@commands;
117                 return \@commands;
118     } elsif ($self->{get_state} eq 'msftp-head') {
119                 my @d = unpack('C*', $self->{buffer});
120                
121 #print STDERR "ftp head: ".scalar(@d)."\n";
122
123                 if (scalar(@d) == 0 && $self->{body_info}->{total_bytes_read} == $self->{body_info}->{file_length}) {
124 #print STDERR "EOF!!\n";
125                                 $self->{get_state} = 'line';
126                                 return [{ eof => 1, stream => ''}];
127                 }
128
129                 # poe locks up here if length of $d is 0
130                 return [] unless ($#d > 1); # not enough head bytes read
131                
132                 if ($d[0] == 1 && $d[1] == 0 && $d[2] == 0) {
133 #print STDERR "EOF!\n";
134                                 $self->{buffer} = substr($self->{buffer},3);
135                                 $self->{get_state} = 'line';
136                                 return [{ eof => 1, stream => ''}];
137                 }
138                
139                 shift(@d); #don't need the first byte
140                
141                 # lenth of body = byte1 + (byte2 * 256)
142                 $self->{body_info}->{length} = shift(@d) + (shift(@d) * 256);
143                 $self->{body_info}->{bytes_read} = 0;
144 #print STDERR "got body len: ".$self->{body_info}->{length}."\n";
145
146                 # cut the buffer
147                 $self->{buffer} = substr($self->{buffer},3);
148                
149                 $self->{get_state} = 'msftp-body';
150         }
151
152         if ($self->{get_state} eq 'msftp-body') {
153                 # do this?
154                 return [] if (length($self->{buffer}) < $self->{body_info}->{length});
155
156 #               $Debug and warn "stream data bytes read:".$self->{body_info}->{bytes_read}."\n";
157 ##              if ($self->{body_info}->{bytes_read} < $self->{body_info}->{length}) {
158 #               if (length($self->{buffer}) < $self->{body_info}->{length}) {
159 #                       # the complete body has not been read
160 #                       push(@commands,{ stream => $self->{buffer} });
161 #                       $self->{body_info}->{bytes_read} += length($self->{buffer});
162 #                       $self->{body_info}->{total_bytes_read} += length($self->{buffer}); # doesn't get reset
163 #print STDERR "ftp body:".$self->{body_info}->{bytes_read}." which is ".$self->{body_info}->{total_bytes_read}." out of ".$self->{body_info}->{file_length}."\n";
164 #                       $self->{buffer} = '';
165 #                       # not enough bytes
166 #                       #$Debug and warn Dumper \@commands;
167 #                       return \@commands;
168 #               }
169
170                 if ($self->{body_info}->{bytes_read} == $self->{body_info}->{length}) {
171 #print STDERR "Forced EOF with ".length($self->{buffer})." bytes in the buffer\n";
172                         push(@commands,{ eof => 1, stream => '' });
173                         # switch to line by line
174                         $self->{get_state} = 'line';
175                         return \@commands;     
176                 }
177                 my $data = substr($self->{buffer}, 0, $self->{body_info}->{length}, '');
178                 $self->{body_info}->{bytes_read} += length($data);
179                 $self->{body_info}->{total_bytes_read} += length($data); # doesn't get reset
180 #print STDERR "ftp: ".$self->{body_info}->{total_bytes_read}." bytes\n";
181 #print STDERR "ftp body:".$self->{body_info}->{bytes_read}." which is ".$self->{body_info}->{total_bytes_read}." out of ".$self->{body_info}->{file_length}."\n";
182                 push(@commands,{ stream => $data });
183                 if ($self->{body_info}->{total_bytes_read} == $self->{body_info}->{file_length}) {
184 #print STDERR "forced EOF with ".length($self->{buffer})." bytes in the buffer\n";
185                         push(@commands,{ eof => 1, stream => '' });
186                         # switch to line by line
187                         $self->{get_state} = 'line';
188                 } else {
189                         # switch to the header
190                         $self->{get_state} = 'msftp-head';
191                 }
192                 return \@commands
193     }
194        
195     $Debug and warn "GET: ", Dumper \@commands;
196     return \@commands;
197 }
198
199 sub put {
200     my($self, $commands) = @_;
201     return [ map $self->_put($_), @$commands ];
202 }
203
204 sub _put {
205     my($self, $command) = @_;
206 #    $Debug and warn "PUT: ", Dumper $command;
207         if ($self->{ftp} == 1) {
208                         # MSNFTP doesn't have transactions
209                         if (exists($command->{name_only})) {
210                                 if ($command->name eq 'TFR') {
211                                         $self->{get_state} = 'msftp-head';
212                                 }
213                                 $Debug and warn "PUT: ".$command->name.($command->no_newline ? '' : "\r\n");
214                                 return $command->name.($command->no_newline ? '' : "\r\n");
215                         } else {
216                                 $Debug and warn "PUT: ".sprintf "%s %s%s",$command->name, $command->data, ($command->no_newline ? '' : "\r\n");
217                                 return sprintf "%s %s%s",$command->name, $command->data, ($command->no_newline ? '' : "\r\n");
218                         }
219         } else {
220                         $Debug and warn "PUT: ".sprintf "%s %d %s%s",$command->name, $command->transaction, $command->data, ($command->no_newline ? '' : "\r\n");
221                         return sprintf "%s %d %s%s",$command->name, $command->transaction, $command->data, ($command->no_newline ? '' : "\r\n");
222
223         }
224 }
225
226 sub get_pending {
227         my $self = shift;
228         return [ $self->{buffer} ] if length $self->{buffer};
229         return undef;
230 }
231
232 1;
233
Note: See TracBrowser for help on using the browser.