[Mimedefang] Blacklisting senders of forbidden phrases.

[M Jerome Garrett]

I stole some code off of somebody on here that posted a script to add to the
mimedefang-filter file.  This script goes into a subjects.db file and
searches for words/phrases in the subject line that are in the subjects.db
database.  If they are then the messages is rejected and management is
happy.  I call the search like this.

 

if (lookup_subject() && $auto_whitelist < 1) {
        action_bounce("Access denied. Subject \"$Subject\" suggests MSG may
contain SPAM/WORM/VIRUS/HOAX.", "553", "5.7.1");
        return action_discard();
    }


I want to be able to add a line in the (lookup_subject) function (something
like addline to /etc/mail/blacklist "$Sender REJECT" )to be able to add a
line to my blacklist.db file (which is very similar to the (lookup_subjects)
function) But I do not know perl well enough to know how to complete this
task.  Does anybody know how to add a line to a file in this case? 

 
Attached is the (lookup_subjects) function:

$DBFilenameSUBS = "/etc/mail/subjects.db";
sub lookup_subject() {
    # convert incoming subject to lower-case
    my $lc_subject = lc($Subject);
    my $subject_result = 0;

    my %GDB;
    if (tie(%GDB,'DB_File', $DBFilenameSUBS, O_RDONLY)) {
        # remove white space from the middle so that
        # "free s t    u f f here" becomes "free s t u f f here"
        $lc_subject =~ s/(\s)\s+/$1/g;
        # next 2 lines collapse "free  s t u f f  here" into "free stuff
here"
        $lc_subject =~ s!((^|\s)\S\s(\S(\s|$)){2,})!
            my $lc_subject_x=$1;$lc_subject_x=~s/\s//g;sprintf
"%s","$lc_subject_x ";!ego;
        $lc_subject =~ s/^\s+//;  # Trim leading whitespace
        $lc_subject =~ s/\s+$//;  # Trim trailing whitespace
        $lc_subject =~ s/^re://;  # Trim leading "re:"
        $lc_subject =~ s/^fw://;  # Trim leading "fw:"
        $lc_subject =~ s/^fwd://; # Trim leading "fwd:"
        $lc_subject =~ s/\s+/./g; # Collapse whitespace into periods

        # Scan database for a complete match (only)
        if ($GDB{$lc_subject}) {
            $subject_result = 1;
            md_graphdefang_log("Subject_Line", "Subject-line found in
subjects.db");
        } else {
            # See if any one word in the subject appears as a record
            @subject_array = split (/\./, $lc_subject);
            foreach $subject_word (@subject_array)
            {
                if ($GDB{$subject_word}) {
                    $subject_result = 1;
                    md_graphdefang_log("Subject_Word",
                        "Subject-word \"$subject_word\" found in
subjects.db");
                    last;
                }
            }
        }
        if (!$subject_result)
        {
            # here we reverse the logic... see if any record in the database
            # is found as a substring in the subject.  if a record contains
            # "free.stuff" and the subject says "get your free stuff here",
            # then flag it as a hit.
            my $subject_record;
            foreach $subject_record (keys %GDB)
            {
                if ($lc_subject =~ m/(^|\.)\Q$subject_record\E($|\.)/)
                {
                    $subject_result = 1;
                    md_graphdefang_log("Subject_Substring",
                        "Subject-substring \"$subject_record\" found in
subject line");
                    last;
                }
            }
        }
        untie %GDB;
    } else {
        md_syslog('warning', "subject: Cannot open file $DBFilenameSUBS");
    }
    return $subject_result;
}
#############################