Changeset 961

Show
Ignore:
Timestamp:
10/23/03 20:11:31
Author:
xantus
Message:

lots of changes, MSFTP added, filter works correctly now

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • POE-Component-Client-MSN/trunk/lib/POE/Filter/MSN.pm

    r926 r961  
    55 
    66use vars qw($Debug); 
    7 $Debug = 1
     7$Debug = 0
    88 
    99sub Dumper { require Data::Dumper; local $Data::Dumper::Indent = 1; Data::Dumper::Dumper(@_) } 
     
    1111sub new { 
    1212    my $class = shift; 
    13     bless { 
    14         buffer => '', 
    15         get_state => 'line', 
    16         body_info => {}, 
    17     }, $class; 
     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); 
    1824} 
    1925 
    2026sub 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 
     46sub 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 
     58sub get_one { 
    2159    my($self, $stream) = @_; 
    22     $self->{buffer} .= join '', @$stream; 
     60         
     61    return [] if ($self->{finish}); 
     62         
    2363    my @commands; 
    2464    if ($self->{get_state} eq 'line') { 
    25         while ($self->{buffer} =~ s/^(.{3}) (?:(\d+) )?(.*?)\r\n//){ 
    26             my $command =  POE::Component::Client::MSN::Command->new($1, $3, $2); 
    27             if ($command->name eq 'MSG') { 
    28                 # switch to body 
    29                 $self->{get_state} = 'body'; 
    30                 $self->{body_info} = { 
    31                     command => $command, 
    32                     length  => $command->args->[2], 
    33                 }; 
    34                 last; 
    35             } else { 
     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); 
    36112                push @commands, $command; 
    37             } 
    38         } 
     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 
    39193    } 
    40  
    41     if ($self->{get_state} eq 'body') { 
    42         if (length($self->{buffer}) < $self->{body_info}->{length}) { 
    43             # not enough bytes 
    44             $Debug and warn Dumper \@commands; 
    45             return \@commands; 
    46         } 
    47         my $message = substr($self->{buffer}, 0, $self->{body_info}->{length}, ''); 
    48         my $command = $self->{body_info}->{command}; 
    49         $command->message($message); 
    50         push @commands, $command; 
    51  
    52         # switch to head 
    53         $self->{get_state} = 'line'; 
    54     } 
     194         
    55195    $Debug and warn "GET: ", Dumper \@commands; 
    56196    return \@commands; 
     
    64204sub _put { 
    65205    my($self, $command) = @_; 
    66     $Debug and warn "PUT: ", Dumper $command; 
    67     return sprintf "%s %d %s%s", 
    68         $command->name, $command->transaction, $command->data, ($command->no_newline ? '' : "\r\n"); 
     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 
     226sub get_pending { 
     227        my $self = shift; 
     228        return [ $self->{buffer} ] if length $self->{buffer}; 
     229        return undef; 
    69230} 
    70231