FlipsideReality Once upon a time, in a land far far away…

7Oct/080

Spamassasin sa-learn automatic from exchange mailbox

I needed a script to auto bayes learn spam, there were a couple out there, but all old, and none of them did imaps, which is what exchange needs. So herre you go:

#!/usr/bin/perl
#
# 20081006
# from flipsidereality.com
#
# script to pull spam and ham from exchange by imaps, push it through sa-learn, and then delete it from the exchange server.

use Mail::IMAPClient;
use IO::Socket::SSL;

my $debug=0;
my $salearn;
# Define our server and credentials here
my $username = 'XXXXXX';
my $password = 'xxxxxxxx';
my $server = 'imaps.mail.server';
my $spam_folder = 'bySPAM';
my $ham_folder = 'byFALSE_POSITIVE';
my $amavis_user = 'amavis'; # User to run sa-learn in the context of,

# Open an SSL session to the IMAP server
# Handles the SSL setup, and gives us back a socket
my $ssl=new IO::Socket::SSL("$server:imaps");
die ("Error connecting - $@") unless defined $ssl;
$ssl->autoflush(1);

# Initialise the IMAP object
# Annoyingly, when giving it a Socket, it won't do the initial IMAP
# welcome stuff, so we have to do that ourselves a little later on
my $imap=Mail::IMAPClient->new(
	Socket => $ssl,
	Debug => $debug,
	User => $username,
	Password => $password,
	Peek => 0
);

# Tell Mail::IMAPClient we're connected
$imap->State(Mail::IMAPClient::Connected);

# Get the IMAP Server to the point of accepting a login prompt
# Basically, we skip over the welcome messages until at the OK stage
my ($code, $output) = ("","");
until ( $code ) {
	$output = $imap->_read_line or return undef;
	for my $o (@$output) {
		$imap->_debug("Connect: Received this from readline: ".join("/",@$o)."\n");
		$imap->_record($imap->Count,$o);        # $o is a ref
		next unless $o->[Mail::IMAPClient::TYPE] eq "OUTPUT";
		($code) = $o->[Mail::IMAPClient::DATA] =~ /^\*\s+(OK|BAD|NO)/i  ;
	}
}
# Did we get an OK welcome back?
if ($code =~ /BYE|NO /) {
	$imap->State("Unconnected");
	die "IMAP server disconnected";
}

# Now, have Mail::IMAPClient send the login for us
$imap->login;

if (!defined($imap)) { die "IMAP Login Failed"; }

# If debugging, print out the total counts for each mailbox
if ($debug) {
  my $spamcount = $imap->message_count($spam_folder);
  print ">>> ", $spamcount, " $spam_folder to process <<<\n";

  my $nonspamcount = $imap->message_count($ham_folder);
  print ">>> ", $nonspamcount, " $ham_folder to process <<<\n" if $debug;
}

# Process the spam mailbox
$imap->select($spam_folder);
my @msgs = $imap->search("ALL");
for (my $i=0;$i <= $#msgs; $i++)
{
  # I put it into a file for processing, doing it into a perl var & piping through sa-learn just didn't seem to work
  $imap->message_to_file("/tmp/salearn",$msgs[$i]);

  # execute sa-learn w/data
  if ($debug) { $salearn = `su $amavis_user -c '/usr/bin/sa-learn -D --no-sync --showdots --spam /tmp/salearn'`; }
  else { $salearn = `su $amavis_user -c '/usr/bin/sa-learn --no-sync --showdots --spam /tmp/salearn'`; }
  print "-------\nSpam: ",$salearn,"\n-------\n" if $debug;

  # delete processed message
  $imap->delete_message($msgs[$i]);
  unlink("/tmp/salearn");
}
$imap->expunge();
$imap->close();

# Process the not-spam mailbox
$imap->select($ham_folder);
my @msgs = $imap->search("ALL");
for (my $i=0;$i <= $#msgs; $i++)
{
  $imap->message_to_file("/tmp/salearn",$msgs[$i]);
  # execute sa-learn w/data
  if ($debug) { $salearn = `su $amavis_user -c '/usr/bin/sa-learn -D --no-sync --showdots --ham /tmp/salearn'`; }
  else { $salearn = `su $amavis_user -c '/usr/bin/sa-learn --no-sync --showdots --ham /tmp/salearn'`; }
  print "-------\nNotSpam: ",$salearn,"\n-------\n" if $debug;

  # delete processed message
  $imap->delete_message($msgs[$i]);
  unlink("/tmp/salearn");
}
$imap->expunge();
$imap->close();
$imap->logout();

# integrate learned stuff, but only if there was something to integrate.
if ("$salearn" =~ m/Learned/gi )
{
	my $sarebuild = `su $amavis_user -c '/usr/bin/sa-learn --sync'`;
	print "-------\nSync: ",$sarebuild,"\n-------\n" if $debug;
}
Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
11Sep/083

Recursive unrar unzip perl script

It's a bit hacky, but it works.

#!/usr/bin/perl
use File::Find;
use File::Spec;

if (@ARGV[0] eq '')
{
	print "useage: $0 foldername\n";
}
else
{
	print "Exctacting for folder ". $ARGV[0] ."\n";
	find ( \&extract_dir , @ARGV[0]);
	print (++$n,": $_\n") foreach (@elist) ;
}

exit;

sub extract_dir
{
next if -d $_;
next if /^\./;
my $ff = $File::Find::name;

	# deal with RAR files
	unrar($_,$ff);
	#deal with ZIP files
	if ($ff =~ /\.zip$/i )
	{
		print "unzip $ff";
		system ('unzip','-qq', "$_");
		if ($? != 0)
		{
			push (@elist, $ff);
		}
		else
		{
			print "\nrm -f $ff\n";
			system ('rm', '-f', $_);
		}
	}
}

sub unrar
# takes filename, full filename
{
	if ($_[0] =~ /\.rar$/i)
	{
		if ($_[0] =~ /\.part[0-9]+?\.rar$/i)
		{
			if ($_[0] =~ /\.part[0]+?1\.rar$/i)
			{
				print "unrar x $_[1] \n";
				system ('unrar','x','-y','-inul', "$_[0]");
				if ($? != 0)
				{
					push (@elist, "$_[1]");
				}
				else
				{
					my $todel = $_[0];
					$todel =~ s/\.part[0]+?1\.rar$/\.part*\.rar/g ;
					print "find ./ -name \"$todel\" -exec rm {} \\\;\n";
					system ("find ./ -name \"$todel\" -exec rm {} \\\;");
				}
			}
		}
		else
		{
			print "unrar x $_[1] \n";
			system ('unrar','x','-y','-inul', "$_[0]");
			if ($? != 0)
			{
				push (@elist, "$_[1]");
			}
			else
			{
				my $todel = $_[0];
				$todel =~ s/\.rar$/\.r*/g ;
				print "find ./ -name \"$todel\" -exec rm {} \\\;\n";
				system ("find ./ -name \"$todel\" -exec rm {} \\\;");
			}
		}
	}
}
Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , 3 Comments
1Apr/080

Ubuntu Perl cpan problem

While trying to install various Perl modules I was getting errors like:

 "/usr/lib/perl/5.8/CORE/perl.h:420:24: error: sys/types.h: No such file or direct"

and a load more complaints of missing ".h" files

This is because Ubuntu isn't shipped as Linux for "Developers" but more for end users and so it isn't preinstalled with all sorts of development header files needed for compiling your own or others programs.

So, as root, I ran:

 apt-get install libexpat1-dev

And that solved the problems.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , , No Comments
2Oct/070

Perl tutorials

Oooooh, look. Perl tutorials! yay.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
26Jul/060

Sys Admin > v15, i09: Perl 6 is Coming!

Sys Admin > v15, i09: Perl 6 is Coming!

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , No Comments