Hi Phillipe, Hi Perl users,
I want to implement a little imap proxy with filtering capabilities.
Therefore put a small piece of code into Proxy.pm to do the filtering in a
general manner.
I've appended a patch to Proxy.pm at the end of the posting. Maybe helpful for the further
development.
Example usage
#!/usr/bin/perl
#
use strict;
use Net::Proxy;
my $proxy = Net::Proxy->new( {
in => { type => 'tcp',
port => 143,
hook => \&readData },
out => { type => 'tcp',
host => 'imap.lw-systems.de',
port => '143'},
});
$proxy->register();
Net::Proxy->mainloop();
### CALLBACK ###
sub readData
{
my ($direction,$data) = @_;
# direction may be 'in' or 'out'
if ($direction eq 'in') {
# incoming connection
my ($tag,$cmd,$args) = split /\s+/, $data, 3;
print STDERR "IMAP command: $cmd\n";
}
return $data;
}
Patch to Proxy.pm
--- Proxy.pm_org 2006-03-21 10:03:11.489872434 +0100
+++ Proxy.pm 2006-03-21 10:01:06.200640759 +0100
@@ -19,6 +19,11 @@
in => {},
out => {},
);
+my %CALLBACK = (
+ in => {},
+ out => {},
+);
+
my $VERBOSITY = 0; # be silent by default
#
@@ -57,6 +62,11 @@
$args->{$conn}{_proxy_} = $self;
$CONNECTOR{$conn}{ refaddr $self} = $class->new( $args->{$conn} );
$CONNECTOR{$conn}{ refaddr $self}->set_proxy($self);
+
+ if (ref ($args->{$conn}->{hook}) =~ /CODE/) {
+ $CALLBACK{$conn}{$CONNECTOR{$conn}{ refaddr $self}} =
+ $args->{$conn}->{hook};
+ }
}
return $self;
@@ -202,8 +212,11 @@
my $data = $conn->read_from($sock);
next SOCKET if !defined $data;
- # TODO filtering by the proxy
-
+ # Callback to a custom filter function
+ my $direction = 'in'; $direction = 'out' if $conn->is_out()
;
+ if ($CALLBACK{$direction}{$conn}) {
+ $data = $CALLBACK{$direction}{$conn}($direction,$data);
+ }
Net::Proxy->get_connector($peer)->write_to( $peer, $data );
}
}
