[Evolution] A whitelist filter

[Brad Warkentin <brad warkentin rogers com>]

Good day,

I have been playing with whitelisting as part of my ongoing battle with
spam. It would be a welcome addition to the core Evolution
functionality, and be much faster than piping messages out to the shell
for checking. 

Anyways I thought I would share what I have so far and welcome any
comments or suggestions for improvement.

whitelist.pl
-------------------------------------------------------------------------
#!/usr/bin/perl
# ------------------------------------------------------------------
# Written by Brad Warkentin (ideas from Cliff Wells python script)
#
# Extracts sender's email address from "From:" line of standard
# email message. Checks if sender is in Evolution's address book.
# Match is case insensitive. Used to do whitelist filtering of
# email messages.
# ------------------------------------------------------------------
# ASSUMPTIONS: 
# 1) Shell variable $home is defined
# 2) Evolution address book is in $home/evolution/share/Contacts
# 3) Addressbook is called "addressbook.db"
#
# INPUT:    standard email message
# OUTPUT:   email address if matched
# RETURNS:  0, if sender is in address book
#           1, if sender is not in address book
# ------------------------------------------------------------------
# USAGE: Define a filter with the following:
# If
# Action:  "Pipe Message to Shell Command" 
# Command: whitelist.pl
# Test:    "Returns 0"
# Then
# Action:  "Move to Folder"
# Folder:  "some folder name"
# Action:  "Stop Processing"
# ------------------------------------------------------------------

use strict;
use DB_File;

# Scan through email from STDIN
while ( <> ) {
    if ( /From\:/ ) {
        # Hookey attempt at matching most email addresses
        # Will miss some RFC822 compliant addresses
        if (
/([A-Za-z_0-9][\-A-Za-z_0-9.]+[\-A-Za-z_0-9]\@(?:[\w][\-_\w.]+\w)+\.[A-Za-z]{2,7})/ ) {
            # print "Found: $1 \n";
            &whitelist_email($1);
        }
    }
}

sub whitelist_email {
    my $address_book =
$ENV{'HOME'}.'/evolution/local/Contacts/addressbook.db';
    my $email = shift;
    $email = lc($email);
    my %address_db;
    # Tie Berkeley db format addressbook to hash
    tie %address_db, 'DB_File', $address_book;
    my $key;
    my $record;
    # Walk through all records in addressbook
    while ( ($key, $record) = each %address_db ) {
        my @lines = split /^/, $record; 
        my $line;
        # Each record may contain multiple email address... check them all
        foreach $line ( @lines ) {
            $line =~ /EMAIL\;INTERNET\:(.*)/;
            my $db_email;
            chop ($db_email = $1);
            if ( lc($db_email) eq $email ) {
                # print "KEY: $key \nRECORD: \n$record \n";     
                print "$db_email \n";
                untie %address_db;
                exit;
            }
        }
    }
    untie %address_db;
    exit(1);
}
--------------------------------------------------------------------------

cheers,
brad    

-- 
Brad Warkentin <brad warkentin rogers com>