Hi All,
I'm haveing some problems with my perl code. the script is for a mail filtering program called mimedefang, the code is the main filter.

the fist bit of code is used to filter out mail based on the subject line.

sub filter_begin () {
my($msgSubject, $hfile) = @_;


# ALWAYS drop messages with suspicious chars in headers
if ($SuspiciousCharsInHeaders) {
md_graphdefang_log('suspicious_chars');
action_quarantine_entire_message("Message quarantined because of suspicious characters in headers");
# Do NOT allow message to reach recipient(s)
return action_discard();
}


# Subject check
my($msgSubject);
my($hfile) = "HEADERS";
while(<HEADERS>) {
chomp;
$line = $_;
$idx = index($line, "Subject: ");
if (idx == 0){
$msgSubject = substr($line, 9);
}
}


if (($msgSubject =~ /RE: [A-Z] {2,},(?: [A-Z]+!?)+/) ||
($msgSubject =~ /\bparis hilton\b/ )) {


#Bounce the mail!
action_bounce("Forbiden subject matter - Rejected");
}

this next bit is used to move any mail tagged as spam to an admin/spam folder on the server, following this is the code used to append a header to say that the virus scan was performed and no virus was found.

# If SpamAssassin found SPAM, append report.  We do it as a separate
# attachment of type text/plain
sub filter_end ($) {
my($entity) = @_;


if ($message_is_spam) {
# Add a header with original recipients, just for info
action_add_header("X-Orig-Rcpts", join(", ", @Recipients));


# Remove original recipients
foreach $recip (@Recipients) {
delete_recipient($recip);
}


# Send to spam address
add_recipient('admin@andi.com');
}


#virus checked header
if ($FoundVirus) {
action_add_header("X-virus_checked", "$FoundVirus");
}

the problem that i have is that the code is in place but is not doing anything at the moment. i am not a perl coder and am only guessing at the code. if you can see anything missing or undecleard or just have suggestions they will be welcome.

attached (i hope) is the acctual perl script fillter, so you can see where these bits fit in.

thanks for looking,

spikes

Edited 3 Years Ago by deceptikon: Fixed formatting

Attachments
# -*- Perl -*-
#***********************************************************************
#
# mimedefang-filter
#
# Suggested minimum-protection filter for Microsoft Windows clients, plus
# SpamAssassin checks if SpamAssassin is installed.
#
# Copyright (C) 2002 Roaring Penguin Software Inc.
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
# $Id: suggested-minimum-filter-for-windows-clients,v 1.72 2003/11/14 21:33:20 dfs Exp $
#***********************************************************************

#***********************************************************************
# Set administrator's e-mail address here.  The administrator receives
# quarantine messages and is listed as the contact for site-wide
# MIMEDefang policy.  A good example would be 'defang-admin@mydomain.com'
#***********************************************************************
$AdminAddress = 'admin@visitheartofengland.com';
$AdminName = "admin";

#***********************************************************************
# Set the e-mail address from which MIMEDefang quarantine warnings and
# user notifications appear to come.  A good example would be
# 'mimedefang@mydomain.com'.  Make sure to have an alias for this
# address if you want replies to it to work.
#***********************************************************************
$DaemonAddress = 'warnings@visitheartofengland.com';

#***********************************************************************
# If you set $AddWarningsInline to 1, then MIMEDefang tries *very* hard
# to add warnings directly in the message body (text or html) rather
# than adding a separate "WARNING.TXT" MIME part.  If the message
# has no text or html part, then a separate MIME part is still used.
#***********************************************************************
$AddWarningsInline = 1;

#***********************************************************************
# To enable syslogging of virus and spam activity, add the following
# to the filter:
# md_graphdefang_log_enable();
# You may optionally provide a syslogging facility by passing an
# argument such as:  md_graphdefang_log_enable('local4');  If you do this, be
# sure to setup the new syslog facility (probably in /etc/syslog.conf).
# An optional second argument causes a line of output to be produced
# for each recipient (if it is 1), or only a single summary line
# for all recipients (if it is 0.)  The default is 1.
# Comment this line out to disable logging.
#***********************************************************************
md_graphdefang_log_enable('mail', 1);

#***********************************************************************
# Uncomment this to block messages with more than 50 parts.  This will
# *NOT* work unless you're using Roaring Penguin's patched version
# of MIME tools, version MIME-tools-5.411a-RP-Patched-02 or later.
#
# WARNING: DO NOT SET THIS VARIABLE unless you're using at least
# MIME-tools-5.411a-RP-Patched-02; otherwise, your filter will fail.
#***********************************************************************
# $MaxMIMEParts = 50;

#***********************************************************************
# Set various stupid things your mail client does below.
#***********************************************************************

# Set the next one if your mail client cannot handle nested multipart
# messages.  DO NOT set this lightly; it will cause action_add_part to
# work rather strangely.  Leave it at zero, even for MS Outlook, unless
# you have serious problems.
$Stupidity{"flatten"} = 0;

# Set the next one if your mail client cannot handle multiple "inline"
# parts.
$Stupidity{"NoMultipleInlines"} = 0;

# The next lines force SpamAssassin modules to be loaded and rules
# to be compiled immediately.  This may improve performance on busy
# mail servers.  Comment the lines out if you don't like them.
if ($Features{"SpamAssassin"}) {
    spam_assassin_init()->compile_now(1) if defined(spam_assassin_init());

    # If you want to use auto-whitelisting:
#   if (defined($SASpamTester)) {
#       use Mail::SpamAssassin::DBBasedAddrList;
#       my $awl = Mail::SpamAssassin::DBBasedAddrList->new();
#       $SASpamTester->set_persistent_address_list_factory($awl) if defined($awl);
#   }
}

# This procedure returns true for entities with bad filenames.
sub filter_bad_filename ($) {
    my($entity) = @_;
    my($bad_exts, $re);

    # Bad extensions
    $bad_exts = '(ade|adp|app|asd|asf|asx|bas|bat|chm|cmd|com|cpl|crt|dll|exe|fxp|hlp|hta|hto|inf|ini|ins|isp|jse?|lib|lnk|mdb|mde|msc|msi|msp|mst|ocx|pcd|pif|prg|reg|scr|sct|sh|shb|shs|sys|url|vb|vbe|vbs|vcs|vxd|wmd|wms|wmz|wsc|wsf|wsh|\{[^\}]+\})';

    # Do not allow:
    # - CLSIDs  {foobarbaz}
    # - bad extensions (possibly with trailing dots) at end
    $re = '\.' . $bad_exts . '\.*$';
    return re_match($entity, $re);
}

# Scan for a virus using the first supported virus scanner we find.
sub message_contains_virus () {
    return message_contains_virus_avp()      if ($Features{'Virus:AVP'});
    return message_contains_virus_fprot()    if ($Features{'Virus:FPROT'});
    return message_contains_virus_fsav()     if ($Features{'Virus:FSAV'});
    return message_contains_virus_hbedv()    if ($Features{'Virus:HBEDV'});
    return_message_contains_virus_nai()      if ($Features{'virus:NAI'});
    return message_contains_virus_bdc()      if ($Features{'Virus:BDC'});
    return message_contains_virus_nvcc()     if ($Features{'Virus:NVCC'});
    return message_contains_virus_rav()      if ($Features{'Virus:RAV'});
    return message_contains_virus_sophie()   if ($Features{'Virus:SOPHIE'});
    return message_contains_virus_trophie()  if ($Features{'Virus:TROPHIE'});
    return message_contains_virus_sophos()   if ($Features{'Virus:SOPHOS'});
    return message_contains_virus_trend()    if ($Features{'Virus:TREND'});
    return message_contains_virus_filescan() if ($Features{'Virus:FileScan'});
    return message_contains_virus_clamd()    if ($Features{'Virus:CLAMD'});
    return message_contains_virus_clamav()   if ($Features{'Virus:CLAMAV'});
    return message_contains_virus_carrier_scan() if ($Features{'Virus:SymantecCSS'});
    return (wantarray ? (0, 'ok', 'ok') : 0);
}

# Scan for a virus using the first supported virus scanner we find.
sub entity_contains_virus ($) {
    my($e) = @_;
    return entity_contains_virus_avp($e)      if ($Features{'Virus:AVP'});
    return entity_contains_virus_fprot($e)    if ($Features{'Virus:FPROT'});
    return entity_contains_virus_fsav($e)     if ($Features{'Virus:FSAV'});
    return entity_contains_virus_hbedv($e)    if ($Features{'Virus:HBEDV'});
    return entity_contains_virus_nai($e)      if ($Features{'virus:NAI'});
    return entity_contains_virus_bdc($e)      if ($Features{'Virus:BDC'});
    return entity_contains_virus_nvcc($e)     if ($Features{'Virus:NVCC'});
    return entity_contains_virus_rav($e)      if ($Features{'Virus:RAV'});
    return entity_contains_virus_sophie($e)   if ($Features{'Virus:SOPHIE'});
    return entity_contains_virus_trophie($e)  if ($Features{'Virus:TROPHIE'});
    return entity_contains_virus_sophos($e)   if ($Features{'Virus:SOPHOS'});
    return entity_contains_virus_trend($e)    if ($Features{'Virus:TREND'});
    return entity_contains_virus_filescan($e) if ($Features{'Virus:FileScan'});
    return entity_contains_virus_clamd($e)    if ($Features{'Virus:CLAMD'});
    return entity_contains_virus_clamav($e)   if ($Features{'Virus:CLAMAV'});
    return entity_contains_virus_carrier_scan($e) if ($Features{'Virus:SymantecCSS'});
    return (wantarray ? (0, 'ok', 'ok') : 0);
}

#***********************************************************************
# %PROCEDURE: filter_begin
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail parts are processed
#***********************************************************************
sub filter_begin () {
       my($msgSubject, $hfile) = @_;

    # ALWAYS drop messages with suspicious chars in headers
    if ($SuspiciousCharsInHeaders) {
        md_graphdefang_log('suspicious_chars');
	action_quarantine_entire_message("Message quarantined because of suspicious characters in headers");
	# Do NOT allow message to reach recipient(s)
	return action_discard();
    }
    
     # Subject check
    my($msgSubject);
    my($hfile) = "HEADERS";
    while(<HEADERS>) {
        chomp;
        $line = $_;
        $idx = index($line, "Subject: ");
        if (idx == 0){
                $msgSubject = substr($line, 9);
        }
    }
                                                                                                                             
    if (($msgSubject =~ /RE: [A-Z] {2,},(?: [A-Z]+!?)+/) ||
        ($msgSubject =~ /\bparis hilton\b/ )) {
                                                                                                                             
    #Bounce the mail!
    action_bounce("Forbiden subject matter - Rejected");
    }

    # Scan for viruses if any virus-scanners are installed
    my($code, $category, $action) = message_contains_virus();

    # Lower level of paranoia - only looks for actual viruses
    $FoundVirus = ($category eq "virus");

    # Higher level of paranoia - takes care of "suspicious" objects
    # $FoundVirus = ($action eq "quarantine");

    if ($action eq "tempfail") {
	action_tempfail("Problem running virus-scanner");
	md_syslog('warning', "Problem running virus scanner: code=$code, category=$category, action=$action");
    }
}

#***********************************************************************
# %PROCEDURE: filter
# %ARGUMENTS:
#  entity -- a Mime::Entity object (see MIME-tools documentation for details)
#  fname -- the suggested filename, taken from the MIME Content-Disposition:
#           header.  If no filename was suggested, then fname is ""
#  ext -- the file extension (everything from the last

Scripts "Seperate l00zer SYSOP's from the UBER SYSOP's " .
Some will say that, Oreilly books on PERL are hard to read, but I disagree. PERL will just take time to learn period. I remeber the first Oreilly book I picked up was the Camel book, worth every penny ($40.00 US Dollar) I might add.
www.Perl.Oreilly.com
(add in) report SP@M to UCE@FTC.gov
But over all I would say your trying to reinvent the wheel aka a simple script.
Sign up for Em@ils. @WWC www.worldwidecreations.com/freescripts.htm
Goodluck with the C&P code hope it works out.

sub filter_begin ()

I can't find anywhere in your script where this is being called, therefore it wouldn't do anything.

# Subject check
    my($msgSubject);
    my($hfile) = "HEADERS";
    while(<HEADERS>) {
        chomp;
        $line = $_;
        $idx = index($line, "Subject: ");
        if (idx == 0){
                $msgSubject = substr($line, 9);
        }
    }

You are assigning the value "HEADERS" to $hfile, so:
print $hfile;

would print HEADERS.

If you are trying to read the value of a file, I would suggest passing it as an array, and doing:

foreach $line (@file) {

instead of

while(<HEADERS>) {

Either that or open the file in the function:

open(HEADERS,"filename.txt");

while(<HEADERS>) {

Or pass the file handle to the function:

filter_begin("subject", *HEADERS);

sub filter_begin {
my ($blah, $handle) = @_;

while(<$handle>) {

Sorry if this isn't very clear I haven't been awake long.

HTH
Ben

thanks for the advice, i have found that the headers value is ready defined in the program and i dont have to do anything with it apart from call it.
since the first post in this thread i have got eveything up and running, so as much as i am no closer to really understanding perl, i'll say that this thread is closed and resolved.

cheers

spikes

This question has already been answered. Start a new discussion instead.