Delete Spam from POP3 mailbox

My hosting provider, Digitalspace, uses My former hosting provider used SpamAssasin to help me filter spam. However, being unfamiliar with procmail and the like, I never got around to setting up something that automatically deleted spam from my inbox. Instead, I connect periodically to my POP3 account (using SSH) and manually delete messages tagged as spam.

Lately, however, I got really fed up with this process and decided to write a quick Perl script to do this on my behalf. If you can set it up, I suggest using SSH tunneling for all your communications with the POP3 server since POP3 is a clear text protocol. For Windows PCs you can use PuTTY for this purpose.

Please note that while I provide this script in the hopes that it will be useful to you, I make NO GUARANTEES OR WARRANTIES OF ANY KIND. The code is provided subject to the same terms as Perl itself. For more information, please refer to the Perl Artistic License.

#!/usr/bin/perl

use strict;
use warnings;

$| = 1;

use constant SEVERITY => 5;

use Mail::POP3Client;
use Term::ReadKey;

die "Provide user name\n" unless @ARGV;
my ($user) = @ARGV;

my $pop = Mail::POP3Client->new(HOST => '127.0.0.1', PORT => 9999);

my $pass = prompt_password();
print "\n";

$pop->User($user);
$pop->Pass($pass);
$pop->Connect or die $pop->Message;

my $count = $pop->Count;

$count >= 0 or die "Failed to get message count.\n";
$count >  0 or die "No messages in mailbox.\n";

print "Scanning messages:  ";

my $to_delete = 0;
for my $msg_num (1 .. $count) {
    my @headers = $pop->Head($msg_num);

    for my $h (@headers) {
        if($h =~ /^X-Spam-Level: (\*+)/) {
            if(SEVERITY <= scalar ($1 =~ tr/*/*/)) {
                $to_delete += 1;
                $pop->Delete($msg_num);
                print "\b*>";
            } else {
                print "\b->";
            }
        }
    }
}

print "\b ... done\n";

use Lingua::EN::Inflect qw( PL );

if( $to_delete ) {
    printf "%d %s will be deleted. Commit: [Y/N]?\n",
        $to_delete, PL('message', $to_delete);
    $pop->Reset unless confirm(qr/^Y/i, qr/^N/i);
}

$pop->Close;

print "OK\n";

sub yes {
    my ($ok_re, $cancel_re) = @_;
    while(my $r = <STDIN>) {
        return 1 if $r =~ $ok_re;
        last     if $r =~ $cancel_re;
    }
    return;
}

sub prompt_password {
    print 'Password: ';
    ReadMode 2;
    my $pass = ReadLine 0;
    ReadMode 0;
    chomp $pass;
    return $pass;
}

__END__