huhu/MOD/Spamfilter.pm

######################################################################
#
# $Id: Spamfilter.pm 147 2009-10-13 14:46:07Z alba $
#
# Copyright 2007 - 2009 Roman Racine
# Copyright 2009 Alexander Bartolich
#
# 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 3 of the License, or
# (at your option) any later version.
#
######################################################################
#
# this is a spamfilter which checks incoming mails and marks them
# as probable Spam.
#
# Heuristics are added as needed.
#
# The main function "spamfilter" returns 
# -1 -> discard (post do de.admin.news.announce)
#  0-5 -> no spam, 
#  >5 -> spam
#
######################################################################
package MOD::Spamfilter;

use strict;
use warnings;
use News::Article;
use Mail::SpamAssassin;
use Text::Language::Guess;

$MOD::Spamfilter::VERSION = 0.02;

sub spamfilter;
sub blacklist;
sub spamlearn;
sub new($);
1;

sub new($) {
  my (undef,$configref) = @_;
  my $self = {};
  $self->{'config'} = $configref;
  bless $self;
  return $self;
}    


sub spamfilter_attachment {
     my ($self,$article) = @_;
     my $score = 0;
     if (defined($article->header('Content-Type')) and  $article->header('Content-Type') =~
	 /^multipart\/(?:mixed|alternative);.+boundary="(.+?)"$/s) {
	 my @parts = split($1,(join "\n",$article->body()));
	 for my $part (@parts) {
	     if ($part =~ /^\r?\n?Content-Type: (image|video|audio|application|text\/html)/) {
		 $score = $self->{'config'}->{'attachmentscore'};
		 last;
	     }
	 }
     }
     $article->add_headers('X-Attachment-Test',$score);
     return $score;
 }


sub spamfilter_language {
    my ($self,$article) = @_;
    my $guesser = Text::Language::Guess->new(languages => ['en',$self->{'config'}->{'lang'}]);
    my @messagebody = $article->body();
    my $score = 0;
    my $lang = $guesser->language_guess_string(join "\n",@messagebody);
    if (!defined($lang) or $lang ne $self->{'config'}->{'lang'}) {
	$score = $self->{'config'}->{'langscore'};
    }
    $article->add_headers('X-Lang-Test',$score);
    return $score;
}
    
sub spamfilter_spamassassin {
  my ($self,$article) = @_;
  # use spamassassin
  my $spamtest = Mail::SpamAssassin->new();
  my @messageheader = $article->headers();
  my @messagebody = $article->body();
  my $header = join "\n",@messageheader;
  my $body = join "\n",@messagebody;
  my $status = $spamtest->check_message_text($header . $body);
  my $score = $status->get_score();
  $article->add_headers('X-Spamassassin-Test',$score);
  return $score;
}

sub blacklist {
   my ($self,$article) = @_;
   return 1 if ($article->header('Newsgroups') =~ /de.admin.news.announce/);
   return 1 if (defined($article->header('Newsgroups')) and 
      $article->header('Newsgroups') !~ /$self->{'config'}->{'moderated_group'}/);
   return 1 if (!defined($article->header('From')));
   return 1 if (length($article->header('From')) < 2);
   return 1 if ($article->bytes() > 100*1024);
   # kaputte Postings
   for my $headerline (qw(From Reply-To Subject Message-ID)) {
       if (defined ($article->header($headerline)) and
           length($article->header($headerline)) > 1019) {
           return 1;
        }
    }
   if (defined $self->{'config'}->{'blacklistfile'}) {
     my $header = join "\n",$article->headers();
     open(my $blacklistfile, $self->{'config'}->{'blacklistfile'}) or die $!;
     while (<$blacklistfile>) {
       chomp;
       next if (length($_) <= 2);
       if ($header =~ /$_/s) {
         close $blacklistfile;
         return 1;
       }
     }
     close $blacklistfile;
   }
   return 0;
}

sub spamlearn {
  my ($input,$isspam) = @_;
  return;
#  my $message = Mail::SpamAssassin::Message->new({'message' => $input});
#  my $spamtest = new Mail::SpamAssassin ({
#    'rules_filename'      => '/etc/spamassassin.rules',
#     'userprefs_filename'  => $ENV{'HOME'}. '/.spamassassin/user_prefs'
#   });
#  my $mail = $spamtest->parse($message);
#  my $status = $spamtest->learn($mail,undef,$isspam,0);
#  $status->finish();                                                                              
  
#  my $spamobj = Mail::SpamAssassin->new();
#  print defined $spamobj,"\n";
#  $spamobj->learn($message,undef,$isspam,0);
}