package cbcfilter; use strict; use POE::Filter; use Crypt::CBC; use MIME::Base64; use CGI qw(escape unescape); our @ISA = qw(POE::Filter); use Carp qw(carp croak); sub BUFFER () { 0 } sub CIPHER () { 1 } # NOTE: no worries, $filter->clone() gets called for every new client and this # bless is completely compatible with the clone we inherit from the ISA ablove # (including clearing the buffer). :) sub new { my $class = shift; my $file = shift; my $obtai = shift; my $key; if( $file and -f $file ) { open my $keyio, $file or croak "couldn't open keyfile=\"$file\": $!"; local $/ = undef; my $entire_key = <$keyio>; close $keyio; $key = decode_base64( $entire_key ); } croak "no keyfile specified or no key found inside it (file=$file)" unless $key; my $cbc = Crypt::CBC->new({ key=>$key, cipher=>'Blowfish', header=>"randomiv" }); return bless [ '', $cbc ], $class; } sub get_one_start { my ($this, $stream) = @_; local $" = ""; $this->[BUFFER] .= "@$stream"; } sub get_one { my $this = shift; if( $this->[BUFFER] =~ s/([^<>]*)<\/msg>//s ) { my $msg = $1; return [] unless length $msg and $msg =~ m/RandomIV/; return [ $this->[CIPHER]->decrypt( unescape($msg) ) ]; } return []; } sub put { my ($this, $msgs) = @_; my $cbc = $this->[CIPHER]; my @ret = (); for my $msg ( @$msgs ) { $msg = escape( $cbc->encrypt($msg) ); push @ret, "$msg"; } return \@ret; } sub get_pending { my $this = shift; return [ $this->[BUFFER] ] if length $this->[BUFFER]; return undef; } 1;