Spam / Ham Learning folders for VirtualMin / Maildir-based systems

Written by max on 2009-12-17

I’ve created a simple script that will monitor folders called ‘ham’ and ‘spam’ for new entries. Once found, the ‘ham’ folder will send the message to sa-learn --ham, strip off the headers, and return it to the inbox. The spam folder will simply run sa-learn --spam on the message.

Any additions are welcome!
Download : spam_folders script.

#!/usr/bin/perl -w
# spam_folder - Turns the 'ham' and 'spam' folders 
#               into training folders for spam assassin
# For VirtualMin
# Max Baker <max> 12/17/09
# No license retained, distribute and modify freely
use File::Glob qw/bsd_glob/;
use File::Temp;
use File::Copy qw/copy/;
# Config
$sa_learn = '/usr/bin/sa-learn';
$sa       = '/usr/bin/spamassassin';
@spam  = bsd_glob("/home/*/homes/*/Maildir/.spam/cur/*");
@ham   = bsd_glob("/home/*/homes/*/Maildir/.ham/cur/*");
# Mark everything in spam folder that's not already marked as spam
#  (trust spamassassin header)
foreach my $s (@spam) {
    next if is_marked($s);
    system("$sa_learn --spam \"$s\" > /dev/null") 
        and warn "sa-learn errored on $s\n";
# Mark everything in ham folder as ham, strip off junk and move into
# inbox
foreach my $h (@ham) {
    # Strip off headers
    my $tmp = new File::Temp;
    my $tmp_file = $tmp->filename;
    system("$sa -d \"$h\" > $tmp_file") 
        and die "$sa errored on $h\n";
    # Unmark as spam
    system("$sa_learn --ham $tmp_file > /dev/null") 
        and warn "$sa_learn errored on $tmp_file\n";
    # Remove from ham
    unlink($h) or die "Can't remove $h. $!\n";
    # Move to inbox
    my $new_h = $h;
    $new_h =~ s,Maildir/.*cur/,Maildir/cur/,;
    copy($tmp_file,$new_h) or die "Can't move message to inbox. $tmpfile -> $new_h.  $!\n"
# is_marked() - Looks to see if spam assassin has already tagged this,
sub is_marked {
    my $s = shift;
    open (S,"< $s") or return;
    my $is = 0;
    while (<S>){
        if (/^X-Spam-Flag: YES/i) {
            $is = 1;
    close S;
    return $is;