# vim: set cindent expandtab ts=4 sw=4:
#
# Copyright (c) 1998-2005 Chi-Keung Ho. All rights reserved.
#
# This programe is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# Extmail - a high-performance webmail to maildir
# $Id$
package Ext::MailFilter;
use strict;
use Exporter;
use Fcntl qw(:flock);
use Ext::Storage::Maildir;
use vars qw(@ISA $VERSION);
@ISA = qw(Exporter);
$VERSION = '1.1';
sub new {
my $class = shift;
my %opt = @_;
my $self = {
file => $opt{file} ? $opt{file} : $ENV{HOME}.'/.mailfilter',
lock => $opt{lock} ? 1:0
};
bless $self, $class;
$self->parse; # XXX auto
$self;
}
# XXX new design:
#
# will rename $self->{filter} to $self->{rules}
#
# $rules ----> HASH ref element
# |---> header,value,folder,from,name,options
#
# $whitelist ---> { on => yes/not, path => $path }
# $blacklist ---> { on => yes/not, path => $path }
# $spam2junk ---> { on => yes/not }
# $autoreply ---> { on => yes/not }
# $forward ---> { on => yes/not, addr => $addr }
#
# Priority: whitelist > blacklist > forward > rules > spam2junk
sub parse {
my $self = shift;
my $file = $self->{file};
my $new = 1;
my $ref = ();
my @rules;
# extension
my $whitelist = {};
my $blacklist = {};
my $spam2junk = 0;
my $autoreply = 0;
my $forward = 0;
# ignore opening file error, set the $self->{rules} to empty ARRAY
# ref, or perl will complain, :-)
open(FD, "< $file") or $self->{rules} = [] and return;
while(<FD>) {
chomp;
my $line = $_;
# extension parsing
if (substr($line, 0, 2) eq '#*') {
my $res = substr($line, 2);
if ($res eq 'whitelist') {
$whitelist = { on => 1, path => 'whitelist.cf'};
$self->{whitelist} = $whitelist;
} elsif ($res eq 'blacklist') {
$blacklist = { on => 1, path => 'blacklist.cf'};
$self->{blacklist} = $blacklist;
} elsif ($res eq 'spam2junk') {
$spam2junk = 1;
$self->{spam2junk} = $spam2junk;
} elsif ($res eq 'autoreply') {
$autoreply = 1;
$self->{autoreply} = $autoreply;
} elsif ($res =~ /^forward: (.*)/) {
# forward: user@domain.tld
$forward = 1;
$self->{forward} = $1; # the forward addr
} elsif ($res eq 'forwardcc') {
$self->{forwardcc} = 1;
}
}
# format to design
# example:
#
# ##Name:test rule
# ##From:hzqbbc@hzqbbc.com
# ##Folder:!foo@bar.com
# ##Folder:.Junk
# ##Delete
# ##Continue
# ##Recipient:bbc@aaa.com
# ##Notcontains:haha
# ##Contains:xixi
#
# if ((/^From: .*hzqbbc\@hzqbbc\.com.*/) AND
# (/^To: .*bbc\@aaa\.com.*/) AND
# (/xixi/:b) AND
# (!/haha/:b))
# {
# cc "foo@bar.com"
# EXITCODE=0
# exit
# to "$HOME/.Junk/."
# }
if (!$new) {
if (substr($line, 0, 2) eq '##') {
my $res = substr($line, 2, 5);
if ($res eq 'Recip') {
$ref->{recipient} = substr($line, 12);
} elsif ($res eq 'Folde') {
my $val = substr($line, 9);
next unless $val;
if ($ref->{folder}) {
push @{$ref->{folder}}, $val;
} else {
$ref->{folder} = [$val];
}
} elsif ($res eq 'From:') {
$ref->{from} = substr($line, 7);
} elsif ($res eq 'Subje') {
$ref->{subject} = substr($line, 10);
} elsif ($res eq 'Notco') {
$ref->{notcontains} = substr($line, 14);
} elsif ($res eq 'Conta') {
$ref->{contains} = substr($line, 11);
} else {
next if ($line =~ /:/);
$ref->{options} .= substr($line, 2).' ';
}
} else {
if($ref->{options}) {
$ref->{options} =~ s/\s+$//;
}
push @rules, $ref;
$new = 1;
$ref = ();
}
}
if ($new && substr($line, 0, 6) eq '##Name') {
$new = 0;
$ref->{name} = substr($line, 7);
}
}
close FD;
$self->{rules} = \@rules; # save the ref
}
sub save {
my $self = shift;
my $file = $self->{file};
my $rr = $self->{rules};
my @rules = @$rr;
my $buf = '';
my $username = $ENV{USERNAME};
my $maildir = $ENV{HOME};
my $autoreply = "cc \"| mailbot -A 'X-Sender: \$FROM' -A 'From: \$FROM' ";
# advoid coding too long
$autoreply .= "-m '\$HOME/Maildir/autoreply.cf' \$SENDMAIL -t -f ''\"";
$buf .= "#MFMAILDROP=2\n";
$buf .= "#\n";
$buf .= "# DO NOT EDIT THIS FILE. This is an automatically generated filter.\n";
$buf .= "# Generated by ExtMail $VERSION\n\n";
$buf .= "FROM='$username'\n";
$buf .= "import SENDER\n";
$buf .= "if (\$SENDER eq \"\")\n";
$buf .= "{\n";
$buf .= " SENDER=\$FROM\n";
$buf .= "}\n\n";
if ($self->{whitelist}) {
$buf .= "#*whitelist\n";
$buf .= "foreach /^(Return-path|From): .*/\n";
$buf .= "{\n";
$buf .= " if (lookup( getaddr(\$MATCH), \"\$HOME/Maildir/whitelist.cf\" ))\n";
$buf .= " {\n";
if ($self->{autoreply}) {
# must append the autoreply code, or the 'to' operator will
# terminate the deliver process and ignore autoreply code
# following the whitelist!
$buf .= " $autoreply\n";
}
if ($self->{forward}) {
# must append the forwarding code, or the 'to' operator will
# terminate the deliver process and ignore forwarding code
# behide the whitelist:)
$buf .= " ".($self->{forwardcc}?'cc':'to').
" \"| \$SENDMAIL -f \" '\"\$SENDER\"' \" $self->{forward}\"\n";
}
$buf .= " to \"\$HOME/Maildir/.\"\n";
$buf .= " }\n";
$buf .= "}\n\n";
}
if ($self->{blacklist}) {
$buf .= "#*blacklist\n";
$buf .= "foreach /^(Return-path|From): .*/\n";
$buf .= "{\n";
$buf .= " if (lookup( getaddr(\$MATCH), \"\$HOME/Maildir/blacklist.cf\" ))\n";
$buf .= " {\n";
$buf .= " EXITCODE=0\n";
$buf .= " exit\n"; # XXX discard
$buf .= " }\n";
$buf .= "}\n\n";
}
if ($self->{autoreply}) {
$buf .= "#*autoreply\n";
$buf .= "$autoreply\n\n";
}
if ($self->{forward}) {
my $dist = 'to';
$buf .= "#*forward: $self->{forward}\n";
if ($self->{forwardcc}) {
$buf .= "#*forwardcc\n";
$dist = 'cc';
}
$buf .= "$dist \"| \$SENDMAIL -f \" '\"\$SENDER\"' \" $self->{forward}\"\n\n";
}
for (my $i=0; $i <scalar @rules; $i++) {
my $rule = $rules[$i];
my $dist = 'to';
my $delete = 0;
my $hasattach = 0;
my $folder = $rule->{folder};
my @statements;
$buf .= "##Name:$rule->{name}\n";
$buf .= "##From:$rule->{from}\n";
$buf .= "##Recipient:$rule->{recipient}\n";
$buf .= "##Subject:$rule->{subject}\n";
if ($folder) {
$buf .= "##Folder:$_\n" for (@$folder);
} else {
$buf .= "##Folder:\n";
}
$buf .= "##Notcontains:$rule->{notcontains}\n"
if ($rule->{notcontains});
$buf .= "##Contains:$rule->{contains}\n"
if ($rule->{contains});
if ($rule->{options}) {
for my $o (split(/ /, $rule->{options})) {
$buf .= "##$o\n";
if ($o eq 'Continue') {
$dist = 'cc';
} elsif ($o eq 'Delete') {
$delete = 1;
} elsif ($o eq 'Hasattach') {
$hasattach = 1;
}
}
}
$buf .= "\n";
$buf .= "if (";
if ($rule->{contains}) {
push @statements, "(/".slashes($rule->{contains})."/:b)";
}
if ($rule->{notcontains}) {
push @statements, "(!/".slashes($rule->{notcontains})."/:b)";
}
if ($rule->{from}) {
push @statements, "(/^(From|Sender|Return-Path):.*".slashes($rule->{from})."/)";
}
if ($rule->{recipient}) {
push @statements, "(/^To:.*".slashes($rule->{recipient})."/)";
}
if ($rule->{subject}) {
push @statements, "(/^Subject:.*".slashes($rule->{subject})."/)";
}
if ($hasattach) {
push @statements, "(/^Content-Type: *multipart\\/mixed/)";
}
$buf .= join(" || \\\n", @statements);
$buf .= ")\n";
$buf .= "{\n";
if ($folder) {
my $hasfolder = '';
my $hasforward = '';
my $hasbounce = '';
my $hasdelete = '';
my $hasautoreply = '';
for my $dir (@$folder) {
# * reject with message
# ! forward
# + autoreply
my $flag = substr($dir,0,1); # generate the flag
if ($flag eq '!') {
$hasforward = "\"| \$SENDMAIL -f \" '\"\$SENDER\"' \" ".substr($dir,1)."\"\n";
# $buf .= " ".$dist." \"| \$SENDMAIL -f \" '\"\$SENDER\"' \" ".substr($dir,1)."\"\n";
} elsif ($flag eq '+') {
# disable autoreply in rules since extmail 1.0beta3
$hasautoreply .= " AUTOREPLYFROM=\$SENDER\n";
$hasautoreply .= " `/usr/bin/mailbot -A \"X-Sender: \$SENDER\" -A \"From: \$AUTOREPLYFROM\" ";
$hasautoreply .= " -M \"\$SENDER\" -m \"\$HOME/Maildir/autoresponses/".substr($dir,1)."\" \$SENDMAIL -t -f \"\"`\n";
} elsif ($flag eq "*") {
# reject code
$hasbounce .= " echo \"".substr($dir, 1)."\"\n";
$hasbounce .= " EXITCODE=77\n";
$hasbounce .= " exit\n";
} elsif ($flag eq '.') {
# $buf .= " ".$dist." \"\$HOME/Maildir/";
$hasfolder .= "\"\$HOME/Maildir/";
if ($dir eq '.') {
# The Inbox (.) so only prepend the dot(.)
$hasfolder .= ".\"\n";
} else {
$hasfolder .= "$dir/.\"\n";
}
} elsif ($dir eq 'exit' || $delete) {
$hasdelete .= " EXITCODE=0\n";
$hasdelete .= " exit\n";
}
}
# assemble main excution rules in order
if ($hasfolder) {
$buf .= " ".($hasforward || $hasbounce ? 'cc':'to');
$buf .= " $hasfolder";
}
if ($hasforward) {
$buf .= " ".($hasbounce ? 'cc':'to');
$buf .= " $hasforward";
}
if ($hasbounce) {
$buf .= $hasbounce;
}
if ($hasdelete) {
$buf .= ($hasbounce?'': $hasdelete);
}
}
$buf .= "}\n\n";
}
# XXX the end of loop
if ($self->{spam2junk}) {
$buf .= "#*spam2junk\n";
$buf .= "if (/^X-Spam-Flag:.*YES/)\n";
$buf .= "{\n";
$buf .= " to \"\$HOME/Maildir/.Junk/.\"\n";
$buf .= "}\n\n";
}
$buf .= "to \"\$HOME/Maildir/.\"\n";
eval {
open(FD, "> $file.tmp") or die "Can't write to $file.tmp, $!\n";
flock(FD, LOCK_EX);
print FD $buf;
flock(FD, LOCK_UN);
close FD;
rename("$file.tmp", $file) or die "Rename err, $!\n";
};
if ($@) {
return $@;
} else {
return 0;
}
}
sub slashes {
$_ = shift;
s/ /\\ /g;
s/-/\\-/g;
s/_/\\_/g;
s/\+/\\+/g;
s/:/\\:/g;
s/'/\\'/g;
s/>/\\>/g;
s/\//\\\//g;
s/\./\\./g;
s/@/\\@/g;
s/\[/\\[/g;
s/]/\\]/g;
s/</\\</g;
return $_;
}
sub rules_up {
my $self = shift;
my $rules = $self->{rules};
my $id = $_[0];
return 1 if ($id <= 0 || $id >scalar @$rules -1);
my $tmp_ref = ();
$tmp_ref = $rules->[$id-1];
$rules->[$id-1] = $rules->[$id];
$rules->[$id] = $tmp_ref;
$self->{rules} = $rules;
0; # success
}
sub rules_down {
my $self = shift;
my $rules = $self->{rules};
my $id = $_[0];
return 1 if ($id<0 || $id>=scalar @$rules -1);
my $tmp_ref = ();
$tmp_ref = $rules->[$id+1];
$rules->[$id+1] = $rules->[$id];
$rules->[$id] = $tmp_ref;
$self->{rules} = $rules;
0;
}
sub rules_remove {
my $self = shift;
my $rules = $self->{rules};
my $id = $_[0];
return 1 if($id<0 || $id>scalar @$rules -1);
my $new_rules = []; # ARRAY ref
for (my $i=$id; $i< scalar @$rules-1;$i++) {
$rules->[$i]=$rules->[$i+1];
}
pop @$rules;
$self->{rules} = $rules;
}
sub rules_append {
my $self = shift;
my $rules = $self->{rules};
my $ref = $_[0];
push @$rules, $ref;
}
sub save_list {
my $self = shift;
my $type = $_[0];
my $list = $_[1]; # must ARRAY ref
die "Malformed input data!\n" unless (ref $list eq 'ARRAY');
if ($type eq 'blacklist') {
open (FD, "> blacklist.cf.tmp") or die "Can't write to $type.cf.tmp\n";
flock (FD, LOCK_EX);
for (@$list) {
print FD $_, "\n";
}
flock (FD, LOCK_UN);
close FD;
rename ('blacklist.cf.tmp', 'blacklist.cf') or return $!;
} elsif ($type eq 'whitelist') {
open (FD, "> whitelist.cf.tmp") or die "Can't write to $type.cf.tmp\n";
flock (FD, LOCK_EX);
for (@$list) {
print FD $_, "\n";
}
flock (FD, LOCK_UN);
close FD;
rename ('whitelist.cf.tmp', 'whitelist.cf') or return $!;
} else {
return "$type not support yet!\n";
}
return 0;
}
sub read_list {
my $self = shift;
my $type = $_[0];
unless ($type =~ /^(black|white)list$/) {
die "$type not support yet!\n";
}
open (FD, "< $type.cf") or return []; # ignore error
my @arr;
while(<FD>) {
chomp;
s/^\s*//g;
s/\s*$//g;
push @arr, $_;
}
close FD;
return \@arr;
}
sub read_autoreply {
my $self = shift;
my $buf = '';
my $crlf = $/;
open (FD, "< autoreply.cf") or return $buf; # ignore error
local $/ = "\n\n";
<FD>; # strip the header
local $/ = undef;
$buf = <FD>;
close FD;
return $buf;
}
sub save_autoreply {
my $self = shift;
my $buf = $_[0];
open (FD, "> autoreply.cf") or return "Error: $!\n";
flock (FD, LOCK_EX);
print FD $buf;
flock (FD, LOCK_UN);
close FD;
return 0;
}
# XXX this func is useful
sub dir_inrule {
my $self = shift;
my $dir = $_[0];
my $rules = $self->{rules};
return 0 unless(valid_dirname($dir));
$dir = _name2mdir($dir);
foreach my $ref (@$rules) {
if ($ref->{folder}) {
for (@{$ref->{folder}}) {
return $ref->{name} || '1'
if ($_ eq $dir);
}
}
}
0;
}
1;
syntax highlighted by Code2HTML, v. 0.9.1