#!/usr/bin/perl
# Looks at all the mails waiting in a multi-drop pop3 box, and discard
+s
# any that would not be delivered to local users anyway.
# (Using getpwname and Mail::Alias to recognise local users)
# $Revision: 1.2 $ $Date: 2003/12/03 00:39:41 $
use warnings;
use Net::POP3;
use Mail::Header;
use Mail::Field;
use Mail::Field::Received; # complain if not installed!
use Mail::Address;
use Mail::Alias;
use Regexp::Common 'net';
use Geo::IP::PurePerl;
use XML::LibXML;
# use Data::Dumper;
use Data::Dump::Streamer 'Dumper';
$| = 1;
$DEBUG = 0;
# Log headers of mail that gets deleted here:
# (my fetchmail runs as root, YMMV)
# my $LOGFILE = $ENV{HOME} . "/pop3clean.log";
my $LOGFILE = "/root/pop3clean.log";
# print $LOGFILE;
# Sendmails aliases file lives here:
my $mailaliases = "/etc/aliases";
# Fetchmails UIDL store, if using (else will get all mails!)
my $uidlsfile = '/root/.fetchids';
# Edit to fit your POP3 account:
my ($user, $passwd, $host) = ('desert-i', 'XXX', 'mail.m.isar.de');
# XML Email addressbook
my $XMLBook = '/home/castaway/perl/data/emaillist.xml';
# Countries we dont want mail from:
my @countries = ('KR', 'CN', 'CL', 'AR', 'MX');
# My addresses:
my @me = ('castaway@desert-island.m.isar.de',
'me@localhost'
);
######################################################################
+########
# GeoIP Object
my $gip = Geo::IP::PurePerl->new();
# Addressbook parser:
my $parser = XML::LibXML->new();
my $addrbook = $parser->parse_file($XMLBook) ;
my @addresses = map { my $e =$_->textContent();
$e =~ s/\n//g;
$e =~ s/\s+$//g;
# $e }
Mail::Address->parse($e)}
$addrbook->findnodes('descendant::email/child::text()');
@addresses = map {$_->address() } @addresses;
my @listaddresses = map { my $e =$_->textContent();
$e =~ s/\n//g;
$e =~ s/\s+$//g;
# $e }
Mail::Address->parse($e)}
$addrbook->findnodes('descendant::address[attribute::type="list"]/desc
+endant::email/child::text()');
@listaddresses = map {$_->address() } @listaddresses;
debug(Dumper(\@listaddresses));
# Parse UIDL file: expected, newline separated <user>@<pop3server> UID
+L
my @uidls = do { local(@ARGV) = $uidlsfile; <> };
debug("Found:" . Dumper(\@uidls). "\n");
@uidls = map { chomp; (split(/\s+/, $_))[1] } @uidls;
debug("Found:" . Dumper(\@uidls). "\n");
open(LOGFILE, ">>$LOGFILE") or
die "Can't open $LOGFILE for append, ($!)\n";
my $aliases = Mail::Alias->new($mailaliases);
debug("Aliases: " . Dumper($aliases) . "\n");
my $pop = Net::POP3->new($host,Timeout=>30) or
die "Can't connect to $host: ($!)\n";
my $messages = $pop->login($user=>$passwd) or
die "Can't log in:",$pop->message,"\n";
my $last = $pop->last(); # BROKEN!
debug("You have $messages - $last messages\n");
my $msguidl = $pop->uidl();
debug("Found:" . Dumper($msguidl). "\n");
my @msgs = sort {$a<=>$b}
grep { my $uidl = $msguidl->{$_};
!grep { $uidl eq $_ } @uidls }
keys %$msguidl;
debug("Found:" . Dumper(\@msgs). "\n");
foreach my $msgnum (@msgs)
# foreach my $msgnum ($last+1 .. $messages)
# foreach my $msgnum (keys %$msgs) # Test! (all mesgs)
{
my $delete = 0;
my $reason = 1;
debug($msgnum, "\n");
my $header = $pop->top($msgnum);
debug(Dumper($header));
my $mh = Mail::Header->new($header);
debug("Headers: " , Dumper($mh), "\n");
my @mfs = Mail::Field->extract('Received', $mh);
my @fromaddress = Mail::Field->extract('From', $mh)->addresses();
my $to = Mail::Field->extract('To', $mh);
my @toaddress = $to->addresses() if($to);
@toaddress = (@toaddress, Mail::Field->extract('CC', $mh)->address
+es())
if(Mail::Field->extract('CC', $mh));
debug("To: ", Dumper(\@toaddress));
debug("From: ", Dumper(\@fromaddress));
# check against the list we're accepting from:
my $x;
next if(grep {debug("grep1 $_\n"); $x = $_; grep { $_ eq $x } @add
+resses} @fromaddress);
next if(grep {debug("grep2 $_\n"); $x = $_; grep { $_ eq $x } @lis
+taddresses} @toaddress);
$delete = 1, $reason = "Unknown To: address" if(!grep {debug("grep
+3 $_\n"); $x = lc($_); grep { $_ eq $x } @me} @toaddress);
# Check hostname/alias/localuser ?
# Dont accept mails that arent a local user/alias
my $mf = Mail::Field->extract('Received', $mh, 1);
debug("MF" . Dumper($mf) . "\n");
my $res = $mf->parse_tree();
debug("Res:" . Dumper($res). "\n");
my ($addr) = Mail::Address->parse($res->{'for'}->{'for'});
debug(Dumper($addr). "\n") if($addr);
debug("No for address in Mail::Address object?\n") if(!$addr);
if($addr)
{
debug("Alias: ", $aliases->exists($addr->user()), "\n");
debug("Local: ", $addr->user(), "\n");
debug("Local: ", getpwnam($addr->user()), "\n");
$delete = 1 if(!defined(getpwnam($addr->user())) &&
($aliases && !$aliases->exists($addr->user())))
+;
# reverse decision of checking @toaddress, above
# And aliases: local users arent aliased
$delete = 0, $reason = "" if(defined(getpwnam($addr->user())))
+;
if($delete && !$reason)
{
$reason = "Unknown local user/alias: " . $addr->user();
print "Reason (Aliases): $reason\n";
}
}
# Look for the originating address of the mail
# (Starting at the last (original), Received header)
my $ip;
foreach my $field (reverse @mfs)
{
debug("Received headers :" , Dumper($field), "\n");
my $f = $field->parse_tree();
debug("Received headers-parsed :" , Dumper($f), "\n");
debug(Dumper($f), "\n");
$f = $f->{'from'};
debug(Dumper($f), "\n");
$ip=$1 if($f->{'address'} &&
$f->{'address'} =~ /$RE{net}{IPv4}{-keep}/);
$ip = $1 if(!$ip && $f->{'from'} &&
$f->{'from'} =~ /$RE{net}{IPv4}{-keep}/);
if($ip)
{
last;
}
}
debug("IP: $ip\n");
debug("From: ", $gip->country_name_by_addr($ip) ||'', "\n");
debug("From: ", $gip->country_code_by_addr($ip) ||'', "\n");
my $co = $gip->country_code_by_addr($ip) || '';
print "Found Mail from: [$ip] ", ($gip->country_name_by_addr($ip)
+|| ''),"\n";
print LOGFILE "Found Mail from: [$ip] ", ($gip->country_name_by_ad
+dr($ip) || ''),"\n";
# Go to next email, if this is a country we are accepting from
next if((!$co || !grep(/\Q$co\E/, @countries)) && !$delete);
if(!$delete)
{
$reason = "Country: " . $gip->country_name_by_addr($ip);
debug("No reason yet - $reason\n");
}
debug("Oops, thats not a mail for us!\n");
# Default Action, log header, delete file:
print LOGFILE "\n".localtime(), "\n", "Reason: $reason\n",
$mh->as_string(), "\n";
$pop->delete($msgnum);
}
close(LOGFILE);
$pop->quit();
sub debug
{
return if(!$DEBUG);
print @_;
}
|