smeserver-learn/root/usr/bin/Learn.pl

292 lines
12 KiB
Perl
Executable File

#!/usr/bin/perl
#############################################################################
#
# This script has been developed
# by Jesper Knudsen at http://sme.swerts-knudsen.dk
# And modified by Emmanuel Jooris at http://sme.firewall-services.com
#
# Revision History:
#
# January 18, 2006: Initial version
# June 06, 2008: Modification for add LearnAsHam and LearnInWL
# March 06, 2016: adding tmp and new subdir, tag filtering, improvements... JP Pialasse
#############################################################################
use Sys::Hostname;
use Email::Simple;
use esmith::AccountsDB;
use esmith::ConfigDB;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use File::Find;
use File::Copy;
use File::Copy::Recursive;
use File::Basename;
use File::Path;
use Encode qw/encode decode/;
use utf8;
my $hostname = hostname();
#Opening databases
my $adb = esmith::AccountsDB->open_ro()
or die "Could not open AccountsDB ( reason : ".esmith::DB->error." )\n";
my $sadb = esmith::ConfigDB->open_ro()
or die "Could not open ConfigurationDB ( reason : ".esmith::DB->error." )\n";
# some variables of interest
my $subjectTAG= $sadb->get_prop("spamassassin", "Subject");
my $tag= $sadb->get_prop("LearnAsSpam", "tag");
my $MessageRetentionTime = $sadb->get_prop('spamassassin', '$MessageRetentionTime')|| "15";
my $DelayToMove = $sadb->get_prop("LearnAsSpam", "DelayToMove") || $MessageRetentionTime ; # delay in day before moving files
$DelayToMove= $DelayToMove<$MessageRetentionTime ? $DelayToMove : 0; # set 0 to disable
my $agesecs=60*60*24*$DelayToMove; #converts $agedays to seconds
my $daysago=time-$agesecs; #the time stamp of $agedays ago in seconds
my $daysago2=localtime($daysago); #the time stamp of $agedays ago in words - mainly for printing
my $SpamLinks = $sadb->get_prop("LearnAsSpam", "SpamLinks") || "";
my @files;
#getting user list
my @users = $adb->users;
#adding admin
my @admin = $adb->get('admin');
push @users ,@admin;
# getting WL before running
open(SADB, "/home/e-smith/db/spamassassin");
binmode(SADB);
my $md5 = Digest::MD5->new->addfile(SADB)->b64digest;
close(SADB);
#Verbose mode
my $verbose= $sadb->get_prop("Learn", "Verbose") || "enabled";
my $outputfile=($verbose eq "disabled")? "/dev/null": '/tmp/LearnLog.txt';
my $LOG;
open ( $LOG, '+>', $outputfile) unless ($verbose eq "enabled");
# select new filehandle
select $LOG unless ($verbose eq "enabled");
my $currentuser;
# Running for every user
foreach my $user (@users) {
my $firstname = $user->prop('FirstName');
my $lastname = $user->prop('LastName');
my $key = $user->key;
# verification if user included or excluded
my @include= split(',',$sadb->get_prop("Learn", "Include")) if $sadb->get_prop("Learn", "Include");
my @exclude= split(',',$sadb->get_prop("Learn", "Exclude")) if $sadb->get_prop("Learn", "Exclude");
next if ( (@exclude) and @found = grep { $_ eq $key } @exclude );
next unless ( ! (@include) or @found = grep { $_ eq $key } @include );
$currentuser = sprintf("Checking for user (%s): %s %s\n", $key,$firstname, $lastname);
print $currentuser unless ($verbose eq "active");
my $MailDir = ($key eq "admin")? "/home/e-smith" . "/Maildir" : "/home/e-smith/files/users/" . $key . "/Maildir";
my @modes = ("LearnAsSpam","LearnAsHam","LearnInWL");
foreach my $mode (@modes) {
# verificating mode is enabled
if ($sadb->get_prop($mode, "status") ne "enabled") { next; }
# getting dir name to search according to actual mode
my $dirname = $sadb->get_prop($mode, "dir");
if ( !(defined($dirname)) ) {
Vact();print "Errors in DB, dir subkey not present for key $mode\n";
next;
}
# adding heading periode if missing as this is an IMAP folder
if ($sadb->get_prop($mode, "Uniq") eq "enabled") {
$dirname= (substr($dirname, 0, 1) eq '.')? $dirname: ".$dirname";
}
#searching dir : fix to avoid to get multiple dir as default
opendir(LOGDIR, $MailDir);
my @logdirs = ($sadb->get_prop($mode, "Uniq") eq "enabled")? sort grep { /^$dirname$/ } readdir(LOGDIR) :sort grep { /$dirname/ } readdir(LOGDIR);
closedir(LOGDIR);
($login,$pass,$uid,$gid) = getpwnam($key) or die "$key not in passwd file";
# mk dir if not exist
if (! @logdirs and ($sadb->get_prop($mode, "Uniq") eq "enabled")) {
Vact();print "+->mkdir :". $MailDir . "/" . $dirname . "\n";
foreach $a ('','/cur','/tmp','/new'){
mkdir $MailDir . "/" . $dirname . "$a";
chown $uid,$gid,$MailDir . "/" . $dirname . "$a";
}
};
my $junkdir = $MailDir . "/.junkmail";
unless ( -d $junkdir ) {
Vact();print "+->mkdir :". $junkdir . "\n";
foreach $a ('','/cur','/tmp','/new'){
mkdir $junkdir . "/" . "$a";
chown $uid,$gid,$junkdir . "/" . "$a";
}
}
# create junkmail links if necessary
my $Spamlinks = $user->prop('SpamLinks') || "";
if ($mode eq "LearnAsSpam" and ($SpamLinks or $Spamlinks ) ) {
$Spamlinks= $SpamLinks ? $SpamLinks .",". $Spamlinks : $Spamlinks;
$Spamlinks =~ s/,$//;
foreach $a (split(",",$Spamlinks)){
$a=(substr($a, 0, 1) eq '.')? $a: ".$a";
my $Link= $MailDir . "/" . $a;
next if ( $Link eq ".." || $Link eq "." || $Link eq "" );
next if ( -l $Link);
if (-d $Link) {
Vact(); print "+->move previous dir $Link content to $junkdir\n";
File::Copy::Recursive::dirmove($Link, $junkdir) or die "Can't move folder in place of our wanted link from %Link to $junkdir: $!";
#side effect : ownership is lost
@files = ( glob( $junkdir . '/cur/*' ),glob( $junkdir . '/new/*' ), glob( $junkdir . '/tmp/*' ) );
chown $uid, $gid, @files;
};
if (! -e $Link) {
Vact(); print "+->create link $Link on $junkdir\n";
symlink($junkdir, $Link) or die "Can't create symlink from $Link to $junkdir: $!";
};
}
}
# moving junkmail content if we want to check it another time before deleting
# sometime files will get there whithout any spamassassin check ( MUA moving it here)
if ($mode eq "LearnAsSpam" and $sadb->get_prop($mode, "DeleteAfterLearn") eq "enabled" and $DelayToMove >0) {
my $SpamDir = $MailDir . "/" . $logdir . "/cur/";
return unless (-e $SpamDir and -d $SpamDir);
@files=();
find(\&wanted, $junkdir ."/cur" );
find(\&wanted, $junkdir ."/new" ) if ($sadb->get_prop($mode, "LearnNew") eq "enabled" or $sadb->get_prop($mode, "LearnNew") eq "junkmail");
sub wanted {
$filesecs = (stat("$File::Find::dir/$_"))[9]; #GETS THE 9TH ELEMENT OF file STAT - THE MODIFIED TIME
$filesecs2=localtime($filesecs);
if ($filesecs<$daysago && -f){ #-f=regular files
push (@files,"$File::Find::dir/$_");
push (@files,"$filesecs2");
}
}
my %filehash=@files; #puts the array into a hash for easy printing. Key=file, Value=date
undef @files;
foreach $filename (sort keys %filehash){
Vact(); print "--> moving $filename $filehash{$filename}\n";
move $filename,"$MailDir/$dirname/cur" ;
}
}
# loop through all matching directories
foreach my $logdir (@logdirs) {
#sa-learn here to avoid its loading for each files, when it can walk in directories on itself!
my $SpamDir = ($sadb->get_prop($mode, "LearnNew") eq "enabled")? $MailDir . "/" . $logdir : $MailDir . "/" . $logdir . "/cur/" ;
#taking action according to actual mode
my $counter = 0;
find( { wanted => sub { -f && $_ =~ m/($logdir\/cur|$logdir\/new|$logdir\/tmp)/ && $counter++;}, no_chdir => 1, follow_fast => 1 }, $SpamDir );
if ($mode eq "LearnAsSpam" and $counter>0) {
my $result = `/usr/bin/sa-learn --spam $SpamDir`;
chomp($result); Vact(); printf("+Learning Spam from %s: %s\n",$logdir,$result);
}
elsif ($mode eq "LearnAsHam" and $counter>0) {
my $result = `/usr/bin/sa-learn --ham $SpamDir`;
chomp($result); Vact(); printf("+Learning Ham from %s: %s\n",$logdir,$result);
}
@list= ($sadb->get_prop($mode, "LearnNew") eq "enabled") ? ('/cur/','/new/'):('/cur/');
foreach $a (@list){
my $SpamDir = $MailDir . "/" . $logdir . "$a";
# list and sort file in dir
opendir(SPAMDIR, $SpamDir);
my @spamfiles = sort grep { /$hostname/ } readdir(SPAMDIR);
closedir(SPAMDIR);
#
foreach my $spamfile (@spamfiles) {
my $filetolearn = $SpamDir . $spamfile;
my $filetolearnbash = $filetolearn;
$filetolearnbash =~ s/;/\\;/g;
$filetolearnbash =~ s/:/\\:/g;
#taking action according to actual mode
if ($mode eq "LearnInWL") {
Vact(); printf("+Learning in WhiteList: %s\n",$filetolearnbash);
`/usr/bin/LearnInWL.pl $filetolearnbash`;
}
# if we are in LearnAsSpam mode and DeleteAfterLearn is enabled delete message, else tagging a move message
if ($mode eq "LearnAsSpam" and $sadb->get_prop($mode, "DeleteAfterLearn") eq "enabled") {
`rm -f $filetolearn`;
}
else {
if (defined($sadb->get_prop($mode, "tag"))) {
# Opening, reading in one scalar and parsing mail
$/=undef;
open(MAILFILE,"<:encoding(UTF-8)",$filetolearn);
my $emailbrut = <MAILFILE>;
close(MAILFILE);
$/="\n";
my $email = Email::Simple->new($emailbrut);
#changing subject (tagging), opening and writing new mail
my $Subject= $email->header("Subject");
if ( ($mode ne "LearnAsSpam") && ($sadb->get_prop($mode, "RemoveSPAMTag") eq "enabled") ) {
for my $test ( quotemeta $subjectTAG , quotemeta $tag) {
($Subject= $Subject) =~ s/$test//;
}
# we also remove Spam tag or client will move the mail again in spam dir
$email->header_set("X-Spam-Flag",'NO');
$email->header_set("X-Spam-Level",'*');
$email->header_set("X-Spam-Status",'No, score=0.0 required=4.0 autolearn=disabled');
}
# encoding as MIME Q (not B) with UTF8 as default.
my $cleanTag= encode("MIME-Q",$sadb->get_prop($mode, "tag"));
$email->header_set("Subject",$cleanTag.$Subject);
open(MAILFILEWRITE,">","$filetolearn");
print(MAILFILEWRITE $email->as_string);
close(MAILFILEWRITE)
}
my $mvdir;
if ($mode eq "LearnAsSpam") {
$mvdir = $MailDir . "/.junkmail/cur/";
}
else {
$mvdir = $MailDir . "/cur/";
}
`mv $filetolearn $mvdir`;
}
}
}
}
}
}
open(SADB, "/home/e-smith/db/spamassassin");
binmode(SADB);
my $newmd5 = Digest::MD5->new->addfile(SADB)->b64digest;
close(SADB);
# fix for bad ownership of bayes files
system('/bin/chown','spamd:spamd','/var/spool/spamd/.spamassassin/bayes_toks');
if ($newmd5 ne $md5) {
`expand-template /etc/mail/spamassassin/local.cf`;
`/usr/bin/systemctl restart spamassassin.service`;
print "\n";
}
# restore STDOUT
select STDOUT;
# read log and print on STDOUT if mode active
if ($verbose eq "active"){
seek $LOG, 0, 0;
while (<$LOG>) {
print $_;
}
}
close($LOG) unless ($verbose eq "enabled");
unlink $outputfile unless ($verbose eq "disabled");
# sub to print the user line if something happen on active verbose mode
sub Vact() {
return unless ($verbose eq "active");
print $currentuser;
$currentuser="";
}