#!/usr/local/bin/perl

# a simple email filer designed for qmail/vpopmail
# modify stuff under the ####### below (approx. line 50)

use strict;
use Mail::VRFY;
use Mail::vpopmail;

my $domain = $ENV{HOST} || die "environment problem: NULL HOST\n";
my $dirty = $ENV{RECIPIENT} || die "environment problem: NULL RECIPIENT\n";

(my $local = $dirty) =~ s/^${domain}-//;
my $recipient = $local . '@' . $domain;

my $vrfy = Mail::VRFY::CheckAddress( addr => $recipient, method => 'syntax' );
if($vrfy){
	my $english = Mail::VRFY::English($vrfy);
	warn "problem with recipient [$recipient]: $english\n";
	exit 111; # so it stays in queue; you can comment the vrfy code manually
}

my %header;
my $field;
my $folder;
my $i = 0;
my @lines;
while(<STDIN>){
	push @lines, $_;
	last if(/^\s*$/ || $i >= 100);
	chomp;
	my $value;
	if(/^([^:]+)\s*:\s*(.+)/){
		($field,$value) = ( lc($1),$2 );
		$header{$field} = $value;
	}elsif(/^\s+(.+)/){
		$value = $1;
		$header{$field} .= $value;
	}else{
		# invalid email header
		warn "don't know how to filter message: [$_]\n";
		%header = ();
		last;
	}
	$i++;
}
######################################################################

# IMAP folders start with a DOT and are [a-Z0-9\._-]

if( $recipient eq 'test1@example.com' ){
	if($header{from} eq 'evil@example.com'){
		# just bounce his mail
		exit 100;
	}elsif($header{from} eq 'theresa@gmail.com'){
		$folder = '.from_theresa';
	}elsif($header{subject} =~ /\[PLUG\]/){
		$folder = '.plug';
	}elsif($header{x-spam-status}  =~ /\*\*\*\*\*/){
		$folder = '.spam';
	}
}elsif( $recipient eq 'geoff@example.com' ){

}

# else it gets delivered to normal Inbox








######################################################################

my $vchkpw = Mail::vpopmail->new();
my $maildir = $vchkpw->userinfo( email => $recipient, field => 'maildir' );
$maildir .= '/Maildir';
$maildir .= "/$folder" if($folder);

unless( -d $maildir ){
	system( '/var/qmail/bin/maildirmake', $maildir );
}
open(MDD, "| /usr/local/bin/maildirdeliver $maildir/" )
 || die "cannot fork maildirdeliver: $!\n";
foreach my $line (@lines){
	print MDD;
}
while(<STDIN>){
	print MDD;
}
close MDD;
my $code = $? >> 8;

# we treat all disk delivery errors as temporary..
my $xcode = $code ? 111 : 0;
exit $xcode;