#!/usr/bin/perl
# Time-stamp: <2002-09-16 00:01:56 franck>

## Spam: a companion tool to Mailfilter
## (C) 2002 Franck Pommereau <pommereau@univ-paris12.fr>
##
## This program 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.
##
## This program is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
## USA

use strict;
use Getopt::Long;

Getopt::Long::Configure ("bundling");

my $spamrc  = "$ENV{'HOME'}/.spam/deny";

if (! -f $spamrc) {
    warn "Could not find file $spamrc\n";
    warn "Try to run `spam -i'\n";
    exit 1;
}

my %get     = ("from"    => 0,
	       "mailer"  => 0,
	       "subject" => 0,
	       "to"      => 0);

my @headers = ();

my $quiet   = undef;
my $fake    = undef;
my $exact   = undef;
my $log     = undef;
my $allow   = undef;
my $install = "no";

GetOptions ("f|from"     => \$get{"from"},
	    "m|mailer"   => \$get{"mailer"},
	    "s|subject"  => \$get{"subject"},
	    "t|to"       => \$get{"to"},
	    "a|all"      => sub { foreach (keys %get) { $get{$_} = 1 } },
	    "head=s"     => \@headers,
	    "x|exact"    => \$exact,
	    "q|quiet"    => \$quiet,
	    "e|edit"     => sub { &EditDenyFile },
	    "n|no-write" => \$fake,
	    "l|log"      => \$log,
	    "c|check"    => sub { &CheckFiles },
	    "A|allow"    => \$allow,
	    "install!"   => \$install,
	    "h|help"     => sub { print <<"EOF";
Usage: spam [OPTIONS]... [FILES]...
Parse FILES and create rules suitable to mailfilter.

   -f, --from           get header From (default)
   -m, --mailer         get header X-Mailer
   -s, --subject        get header Subject
   -t, --to             get header To
   -a, --all            get all the above headers
       --head=HD        get header HD (any string)
   -x, --exact          rules exactly match headers
   -q, --quiet          run silently
   -e, --edit           edit file .spam/deny
   -c, --check          check consistency between allow and deny files
   -n, --no-write       do not write or change any files
   -l, --log            print a summary of the log file
   -A, --allow          build .spam/allow from FILES
       --install        install spam files and directories
       --noinstall      removes spam files and directories
   -h, --help           display this help and exit

Report bugs to pommereau\@univ-paris12.fr
EOF
    exit; });

if ($install eq "1") {
    &InstallSpam;
} elsif ($install eq "0") {
    &UnInstallSpam;
} elsif ($log) {
    &LogSummary;
} elsif ($allow) {
    &BuildAllow;
} else {
    foreach my $hd (@headers) {
	$hd =~ tr/A-Z/a-z/;
	$get{$hd} = 1;
    }
    my $opt = 0;
    foreach my $key (keys %get) {
	$opt += $get{$key};
    }
    $get{"subject"} = 1 unless $opt;
}

my @rules;

while (my $line = <>) {
    chomp $line;
    if ($line =~ /^Lines:\s*(\d+)$/i) {
	my $count = $1 + 1;
	while ($count) {
	    my $skip = <>;
	    $count--;
	}
    } elsif ($line =~ /^(\S+):/) {
	my $header = $1;
	$header =~ tr/A-Z/a-z/;
	if ($exact) {
	    push @rules, "DENY=^$line\$\n" if $get{$header};
	} else {
	    if ($header eq "subject") {
		$line =~ s/\s{5,}[a-z]+$//i;
		$line =~ s/[^\w\s:]+|\d+|\s{2,}/\.\*/g;
		$line =~ s/\.\*(\.\*|\s)+/\.\*/g;
		$line =~ s/\s+\.\*/\.\*/g;
		$line =~ s/([^\w]|\\s)+$//;
	    } elsif ($header eq "from") {
		$line =~ s/^(From:)\s*(\S+\@\S+)$/$1\.\*$2/i;
		$line =~ s/^(From:).+<(\S+\@\S+)>$/$1\.\*$2/i;
		$line =~ s/\d[^\@]*\@/\.\*\@/g;
		$line =~ s/^(From:)/From[ :]/i;
		$line =~ s/\.\*(\.\*)+/\.\*/g;
	    }
	    push @rules, "DENY=^$line\n" if $get{$header};
	}
    }
}

if (@rules) {
    my $date = `date`;
    if (! $fake) {
	open RC, ">>$spamrc";
	print RC "# $date";
	print RC @rules;
	close RC;
    }
    if (! $quiet) {
	print "Adding rules on $date\n";
	print @rules, "\n";
    }
}

exit;

##
##
##

sub LogSummary {
    my $logfile = "$ENV{'HOME'}/.spam/log/mailfilter.log";
    exit unless -f $logfile;
    open LOG, $logfile;
    while (<LOG>) {
	if (/^mailfilter: (Deleted .*)$/) {
	    my $line = $1;
	    while ($line =~ s/^(.{75})/ > /) {
		print "$1\n";
	    }
	    print "$line\n" if $line;
	}
    }
    close LOG;
    system ("savelog", "-t", "-p", $logfile) unless $fake;
    exit;
}

##
##
##

sub CheckFiles {
    my %allow;

    open ALLOW, "$ENV{'HOME'}/.spam/allow";
    while (<ALLOW>) {
	if (/^ALLOW=\^From:\.\*(.*)$/) {
	    $allow{$1} = 1;
	}
    }
    close ALLOW;

    open DENY, "$ENV{'HOME'}/.spam/deny";
    while (my $line = <DENY>) {
	if ($line =~ /^DENY=\^From/) {
	    while ($line =~ s/([a-z0-9\.\-_]+\@[a-z0-9\.\-_]+)//) {
		print "$1\n" if $allow{$1};
	    }
	}
    }
    close DENY;

    exit;
}

##
##
##

sub BuildAllow {
    my $spamrc = "$ENV{'HOME'}/.spam/allow";
    my %addresses;
    my %reject;
    
    if (-f $spamrc) {
	open RC, $spamrc;
	while (<RC>) {
	    if (/^ALLOW=\^From:\.\*(.*)$/) {
		$addresses{$1} = 1;
	    }
	}
	close RC;
    }
    
    while (<>) {
	chomp;
	if (/^Lines:\s*(\d+)$/i) {
	    my $lines = $1 + 1;
	    while ($lines) {
		my $skip = <>;
		$lines--;
	    }
	} elsif (/^From\s+([a-z0-9\.\-_]+\@[a-z0-9\.\-_]+)\s+/i) {
	    my $address = $1;
	    $address =~ tr/A-Z/a-z/;
	    print "Adding $address\n"
		unless ($addresses{$address} || $quiet);
	    $addresses{$address} = 1;
	} elsif (/^From\s+(\S+)\s+/i) {
	    print "Ignoring $1\n"
		unless ($reject{$1} || $quiet);
	    $reject{$1} = 1;
	} elsif (/^From:.*?([a-z0-9\.\-_]+\@[a-z0-9\.\-_]+)/i) {
	    my $address = $1;
	    $address =~ tr/A-Z/a-z/;
	    print "Adding $address\n"
		unless ($addresses{$address} || $quiet);
	    $addresses{$address} = 1;
	} elsif (/^From:\s*(.*)/i) {
	    print "Ignoring $1\n"
		unless ($reject{$1} || $quiet);
	    $reject{$1} = 1;
	}
    }

    if (! $fake) {
	open RC, ">$spamrc";
	foreach (sort keys %addresses) {
	    print RC "ALLOW=^From:.*$_\n";
	}
	close RC;
    }
    
    exit;
}

##
##
##

sub InstallSpam {
    my $spamhome     = "$ENV{'HOME'}/.spam";
    my $mailfilterrc = "$ENV{'HOME'}/.mailfilterrc";
    if (! -d $spamhome) {
	print "Creating directory $spamhome\n" unless $quiet;
	system ("mkdir", $spamhome) unless $fake;
    }
    if (! -d "$spamhome/log") {
	print "Creating directory $spamhome/log\n" unless $quiet;
	system ("mkdir", "$spamhome/log") unless $fake;
    }
    if (! -f "$spamhome/allow") {
	print "Creating file $spamhome/allow\n" unless $quiet;
	system ("touch", "$spamhome/allow");
    }
    if (! -f "$spamhome/deny") {
	print "Creating file $spamhome/deny\n" unless $quiet;
	system ("touch", "$spamhome/deny");
    }
    if (! -f "$spamhome/log/mailfilter.log") {
	print "Creating file $spamhome/log/mailfilter.log\n" unless $quiet;
	system ("touch", "$spamhome/log/mailfilter.log");
    }
    print "Updating $mailfilterrc\n" unless $quiet;
    if (! $fake) {
	open RC, ">>$mailfilterrc";
	print RC "INCLUDE=$ENV{'HOME'}/.spam/deny\n";
	print RC "INCLUDE=$ENV{'HOME'}/.spam/allow\n";
	print RC "LOGFILE=$ENV{'HOME'}/.spam/log/mailfilter.log\n";
	close RC;
    }
    exit;
}

##
##
##

sub UnInstallSpam {
    my $spamhome     = "$ENV{'HOME'}/.spam";
    my $mailfilterrc = "$ENV{'HOME'}/.mailfilterrc";
    print "Deleting directory $spamhome\n" unless $quiet;
    system ("rm", "-rf", $spamhome) unless $fake;
    print "Updating $mailfilterrc\n" unless $quiet;
    if (! $fake) {
	system ("grep", "-v", "$spamhome/$mailfilterrc",
		">", "$mailfilterrc.tmp");
	system ("mv", "-f", "$mailfilterrc.tmp", $mailfilterrc);
    }
    exit;
}

##
##
##

sub EditDenyFile {
    if ($ENV{"EDITOR"}) {
	system ($ENV{"EDITOR"}, $spamrc);
    } elsif ($ENV{"VISUAL"}) {
	system ($ENV{"VISUAL"}, $spamrc);
    } else {
	system ("vi", $spamrc);
    }
    exit;
}
