Re: OT: Perl IMAP client

[Martin Hepworth]

Kenneth
here's what I use do just that - code originally from someone else. 
mangled slightly by me..

--
Martin Hepworth
Snr Systems Administrator
Solid State Logic
Tel: +44 (0)1865 842300
Kenneth Porter wrote:
I'd like to knock together a utility for invoking SA against messages in 
an IMAP store, and it seems logical to build it as a Perl program using 
an IMAP package and Mail::SpamAssassin. Can anyone recommend a good Perl 
IMAP package?

Server will be Dovecot on Fedora. My utility will take all messages in a 
folder of uncaught spam that aren't wrapped in a SA report, run them 
through the equivalent of sa-learn, wrap them in a SA report, and clear 
their "seen/read" state.

Here's all the hits I get on CPAN for stuff about IMAP:
<http://search.cpan.org/search?m=all&q=imap&s=1&n=100>
**********************************************************************
This email and any files transmitted with it are confidential and
intended solely for the use of the individual or entity to whom they
are addressed. If you have received this email in error please notify
the system manager.
This footnote confirms that this email message has been swept
for the presence of computer viruses and is believed to be clean.       
**********************************************************************
#!/usr/bin/perl -w
use strict;
use Mail::IMAPClient;
use Shell;
use Env qw(HOME);
use Getopt::Long;
use File::Temp qw/ tempfile tempdir /; 

my $imapserver = "myimapserver";

# set to 1 to enable imapclient debugging
my $debug = 0; 

# set to 1 if running under cron (disables output)
my $cron = 1;

my $filename;
my $fh;

my %options = 
(
 uid => undef,
 pwd => undef
);

my $cmdsts = GetOptions ("uid=s" => \$options{uid}, "pwd=s" =>
\$options{pwd});

if (!$options {uid}) { die "[SPAMASSASSIN] uid not set
(-uid=username)\n"; }
if (!$options {pwd}) { die "[SPAMASSASSIN] pwd not set
(-pwd=password)\n"; }

my $uid = $options{uid};
my $pwd = $options{pwd};

# login to imap server
my $imap = Mail::IMAPClient->new (Server=>$imapserver, User=>$uid, 
Password=>$pwd, Debug=>$debug)
        or die "Can't connect to [EMAIL PROTECTED]: $@ $\n";

if ($imap)
{
  my $count;

  # Deal with spam first
  learn_mail ($HOME."/spam/", ".spam", "INBOX.spam", 0, "--spam --showdots 
--prefs-file=/opt/MailScanner/etc/spam.assassin.prefs.conf");

  # Now deal with ham
  learn_mail ($HOME."/ham/", ".ham", "INBOX.ham", 0, "--ham --showdots 
--prefs-file=/opt/MailScanner/etc/spam.assassin.prefs.conf");

}
else
{
  die "[SPAMASSASSIN] Unable to logon to IMAP mail account!
$options{uid}\n";
}

exit;

#
# read and learn mail from imap server
# 
# arguments
#  $dir         directory to place retrieved messages in
#  $ext         file extension to use on retrieved messages
#  $folder      imap folder name on server
#  $shared      0 if imap folder is in users mailbox
#               1 if imap folder is in shared name space or
#  $sa_args     additional arguments to specify to sa-learn
#               (e.g. --spam or --ham)
#
sub learn_mail {
  my $dir = shift (@_);
  my $ext = shift (@_);
  my $folder = shift (@_);
  my $shared = shift (@_);
  my $sa_args = shift (@_);
 
  my $count = 0;

  # tidy up directory before run
  clear_directory ($dir, $ext);

  # read mail from server
  $count = read_mail ($dir, $ext, $folder, $shared);
  if ($count > 0) 
  { 
    # learn about mail
    sa_learn ($dir, $ext, $sa_args); 

    # tidy up files after sa-learn is called
    clear_directory ($dir, $ext);
  }
}


#
# reads mail from an imap folder and saves in a local directory
#
# arguments
#  $dir         directory to place retrieved messages in
#  $ext         file extension to use on retrieved messages
#  $folder      imap folder name on server
#  $shared      0 if imap folder is in users mailbox
#               1 if imap folder is in shared name space or
sub read_mail {
  my $dir = shift (@_);
  my $ext = shift (@_);
  my $folder = shift (@_);
  my $shared = shift (@_);
  my $count = 0;
  my $target = "";

  if ($shared)
  {
    # use a shared public folder instead
    my ($prefix, $sep) = @{$imap->namespace->[2][0]} 
       or die "Can't get shared folder namespace or seperator: [EMAIL 
PROTECTED]";

    $target = $prefix.
       ($prefix =~ /\Q$sep\E$/ || $folder =~ /^\Q$sep/ ? "" : $sep).
       $folder;
  }
  else { $target = $folder; }

  $imap->select ($target) or die "Cannot select $target: [EMAIL PROTECTED]";

  # If a shared public folder is required uncomment the following
  # lines and comment out the previous $imap->select line

  # read through all messages
  my @msgs = $imap->search("ALL");
  foreach my $msg (@msgs)
  {
    ($fh, $filename) = tempfile (SUFFIX => $ext, DIR => $dir);
    $imap->message_to_file ($fh, $msg);
    close $fh;
    $count++;
  }
  $imap->delete_message (@msgs);

  if ($cron == 0) { print "Retrieved $count messages from $target\n"; }

  return $count;
}

#
# Removes files in directory $dir with extension $ext
#
sub clear_directory{
  my $dir = shift (@_);
  my $ext = shift (@_);

  opendir (DIR, $dir) or die "Couldn't open dir: $dir\n";
  my @files = readdir (DIR);
  close (DIR);

  for (my $i = 0; $i <= $#files; $i++ ) 
  { 
    if ($files[$i] =~ /.*?$ext$/) { unlink ($dir.$files[$i]); }
  } 
}


#
# execute sa-learn command
#
sub sa_learn {
  my $dir = shift (@_);
  my $ext = shift (@_);
  my $type = shift (@_);
  my $learncmd = "/usr/local/bin/sa-learn ".$type." --dir ".$dir; 

  if ($cron == 0) { $learncmd .= " --showdots"; }
  else { $learncmd .= " > /dev/null 2>&1"; }

  #
  # Run sa-learn script on spam directory
  #
  my $sh = Shell->new;
  my @args = ($learncmd);

  system (@args) == 0 or die "system @args failed: $?";
}