Listing 1 audit, the end-user script
#! /usr/bin/perl
use strict;
use lib "$ENV{HOME}/lib";
use Symbol;
use Fcntl qw( :flock );
use File::Spec;
use Getopt::Std;
use Mail::Archive::Account;
use Mail::Archive::Manager;
use Mail::Audit;
use Mail::Box::Manager 2.00;
$|++;
my $LOCK = "$ENV{HOME}/.popread.lock";
open my $fh, '>' . $LOCK
or die "Can't open lockfile '$LOCK': $!";
unless (flock $fh, LOCK_EX | LOCK_NB) {
close $fh;
print "Can't get lock... there may be another archive process running.\n";
exit;
}
my %opts;
getopts('XdM:a:e:h:i:j:l:m:p:s:u:', \%opts);
die "Usage: -d only applies to mbox files" if
($opts{d} && ($#ARGV < 0));
die "Usage: Argument to -m must be a directory" if
($opts{m} && -f $opts{m});
do {
die "Usage: Argument to -$_ cannot be a directory"
if ($opts{$_} && -d $opts{$_});
} for qw(i l s);
if ($opts{p} || $opts{h} || $opts{u} || $opts{e}) {
die "Usage: "
unless ($opts{p} && $opts{h} && $opts{u} && $opts{e});
}
my $MAILDIR = $opts{m} || "$ENV{HOME}/mail";
my $LOG = $opts{l} || "$MAILDIR/log"; # a record of mail activity
my $ARCHIVE = $opts{a} || "archive"; # a directory to store audited email
my $INBOX = $opts{i} || "Inbox"; # incoming email mailbox
my $JUNK = $opts{j} || "Junk"; # a catch-all mailbox
my $MODE = $opts{M} || 0770; # permissions for new directories and files
my $SAFE = $opts{X} || 0; # delete incoming mail from POP server?
my $SPAM = $opts{s}; # the name of the spam mailbox
my @accounts =
(
# define accounts here
);
push @accounts,
{
host => $opts{h},
password => $opts{p},
user => $opts{u},
address => $opts{e},
maildir => $MAILDIR,
archive => $ARCHIVE,
inbox => $INBOX,
junk => $JUNK,
spam => $SPAM,
log => $LOG,
mode => $MODE,
safe => $SAFE,
}
if ($opts{h});
die "Usage: No email accounts defined" unless ($#accounts >= 0);
my $manager = Mail::Archive::Manager->new(
accounts => \@accounts,
archive => $ARCHIVE,
inbox => $INBOX,
junk => $JUNK,
log => $LOG,
maildir => $MAILDIR,
mode => $MODE,
spam => $SPAM,
safe => $SAFE,
);
#
# if no arguments, get email from the pop servers...
#
if ($#ARGV < 0) {
$manager->fetch();
exit;
}
#
# otherwise, refile email from existing mailboxes
#
my $mgr = Mail::Box::Manager->new();
my $junkbox = ($JUNK =~ /^\//) ?
$JUNK : File::Spec->catfile($MAILDIR, $JUNK);
for my $mailbox (@ARGV) {
print "Processing mailbox $mailbox... ";
my $box = $mgr->open($mailbox, access => 'rw', extract => 'ALWAYS');
unless (defined($box)) {
print "Error: cannot open mailbox file $mailbox\n";
next;
}
#
# imap mailboxes have an initial message that stores
# information about the mailbox; it does not need to be processed
#
my $start = ($box->message(0)->subject =~ /FOLDER INTERNAL DATA/) ? 1 : 0;
next if ($box->messages < $start);
print "found ".$box->messages." messages... \n";
foreach my $message ($box->messages($start, $box->messages - 1)) {
my $nojunk = 0;
my $item = Mail::Audit->new(
data => [split(/^/m, $message->head . $message->body)],
emergency => $JUNK,
log => $LOG,
loglevel => 2,
noexit => 1,
nomime => 1,
);
next unless $item;
print "From: ", $item->from, "\nTo: ", $item->to, "\n";
for (@{$manager->get_accounts()}) {
$nojunk++ if $_->{filter}($_, $item);
}
$item->accept($junkbox) unless ($nojunk);
$message->delete if $opts{d};
}
print "... Done. \n\n";
$mgr->close($box);
}
exit;
|