Re: utf-8 issue?

# -*- 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: mimedefang-filter,v 1.7 2009/10/12 09:49:13 root Exp $
#***********************************************************************

$SALocalTestsOnly = 0;

#***********************************************************************
# 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 '[email protected]'
#***********************************************************************
$AdminAddress = '[email protected]';
$AdminName = "PKF mail firewall";

#***********************************************************************
# Set the e-mail address from which MIMEDefang quarantine warnings and
# user notifications appear to come.  A good example would be
# '[email protected]'.  Make sure to have an alias for this
# address if you want replies to it to work.
#***********************************************************************
$DaemonAddress = '[email protected]';
$LocalHostName = 'mailhub01';

#***********************************************************************
# 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 = 0;

#***********************************************************************
# 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 multiple "inline"
# parts.
$Stupidity{"NoMultipleInlines"} = 0;

# Detect and load Perl modules
detect_and_load_perl_modules();

# 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 1 if (re_match($entity, $re));

    # Look inside ZIP files
    if (re_match($entity, '\.zip$') and
        $Features{"Archive::Zip"}) {
        my $bh = $entity->bodyhandle();
        if (defined($bh)) {
            my $path = $bh->path();
            if (defined($path)) {
                # 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|zip|\{[^\}]+\})';

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

                return 1 if (re_match($entity, $re));

                return re_match_in_zip_directory($path, $re);
            }
        }
    }
    return 0;
}

#***********************************************************************
# %PROCEDURE: filter_begin
# %ARGUMENTS:
#  $entity -- the parsed MIME::Entity
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail parts are processed
#***********************************************************************
sub filter_begin {
    my($entity) = @_;
    # 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();
    }

    # Copy original message into work directory as an "mbox" file for
    # virus-scanning
    md_copy_orig_msg_to_work_dir_as_mbox_file();

    # 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 ($FoundVirus) {
        md_graphdefang_log('virus', $VirusName, $RelayAddr);
        md_syslog('warning', "Discarding because of virus $VirusName");
        return action_discard();
    }

    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 period in the name
#         to the end of the name, including the period.)
#  type -- the MIME type, taken from the Content-Type: header.
#
#  NOTE: There are two likely and one unlikely place for a filename to
#  appear in a MIME message:  In Content-Disposition: filename, in
#  Content-Type: name, and in Content-Description.  If you are paranoid,
#  you will use the re_match and re_match_ext functions, which return true
#  if ANY of these possibilities match.  re_match checks the whole name;
#  re_match_ext checks the extension.  See the sample filter below for usage.
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  This function is called once for each part of a MIME message.
#  There are many action_*() routines which can decide the fate
#  of each part; see the mimedefang-filter man page.
#***********************************************************************
sub filter {
    my($entity, $fname, $ext, $type) = @_;

    return if message_rejected(); # Avoid unnecessary work

    # Block message/partial parts
    if (lc($type) eq "message/partial") {
        md_graphdefang_log('message/partial');
        action_bounce("MIME type message/partial not accepted here");
        return action_discard();
    }

#    if (filter_bad_filename($entity)) {
#        md_graphdefang_log('bad_filename', $fname, $type);
#       return action_drop_with_warning("An attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
#    }

    # eml is bad if it's not multipart
    if (re_match($entity, '\.eml')) {
        md_graphdefang_log('non_multipart');
        return action_drop_with_warning("A non-multipart attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
    }
    # This will clean up HTML if Anomy::HTMLCleaner is installed.
    # NOTE: We consider Anomy::HTMLCleaner to be TOO BUGGY for
    # production use.  Uncomment the next lines at your peril!
    #if ($Features{"HTMLCleaner"}) {
    #   if ($type eq "text/html") {
    #       return anomy_clean_html($entity);
    #   }
    #}

    return action_accept();
}

#***********************************************************************
# %PROCEDURE: filter_multipart
# %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 period in the name
#         to the end of the name, including the period.)
#  type -- the MIME type, taken from the Content-Type: header.
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  This is called for multipart "container" parts such as message/rfc822.
#  You cannot replace the body (because multipart parts have no body),
#  but you should check for bad filenames.
#***********************************************************************
sub filter_multipart {
    my($entity, $fname, $ext, $type) = @_;

    return if message_rejected(); # Avoid unnecessary work

#    if (filter_bad_filename($entity)) {
#        md_graphdefang_log('bad_filename', $fname, $type);
#       action_notify_administrator("A MULTIPART attachment of type $type, named $fname was dropped.\n");
#       return action_drop_with_warning("An attachment of type $type, named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
#    }

    # eml is bad if it's not message/rfc822
    if (re_match($entity, '\.eml') and ($type ne "message/rfc822")) {
        md_graphdefang_log('non_rfc822',$fname);
        return action_drop_with_warning("A non-message/rfc822 attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
    }

    # Block message/partial parts
    if (lc($type) eq "message/partial") {
        md_graphdefang_log('message/partial');
        action_bounce("MIME type message/partial not accepted here");
        return;
    }

    return action_accept();
}


#***********************************************************************
# %PROCEDURE: defang_warning
# %ARGUMENTS:
#  oldfname -- the old file name of an attachment
#  fname -- the new "defanged" name
# %RETURNS:
#  A warning message
# %DESCRIPTION:
#  This function customizes the warning message when an attachment
#  is defanged.
#***********************************************************************
sub defang_warning {
    my($oldfname, $fname) = @_;
    return
        "An attachment named '$oldfname' was converted to '$fname'.\n" .
        "To recover the file, right-click on the attachment and Save As\n" .
        "'$oldfname'\n";
}

my $sendmailCF_file = '/etc/mail/sendmail.cf';
open(sendmailCF_file_OPEN, $sendmailCF_file) or die("Could not open $sendmailCF_file\n$!");
my @raw_lines = <sendmailCF_file_OPEN>;
close(sendmailCF_file_OPEN);
my @good_lines = ();
for my $line (@raw_lines) {
    if ($line =~ /D\{sendmailMTACluster\}/) {
        chomp($line);
        @fields = split('}', $line);
        $sendmailMTACluster = $fields[1];
        }
    }


sub filter_end {
    my($entity) = @_;

    # If you want quarantine reports, uncomment next line
    # send_quarantine_notifications();

    # IMPORTANT NOTE:  YOU MUST CALL send_quarantine_notifications() AFTER
    # ANY PARTS HAVE BEEN QUARANTINED.  SO IF YOU MODIFY THIS FILTER TO
    # QUARANTINE SPAM, REWORK THE LOGIC TO CALL send_quarantine_notifications()
    # AT THE END!!!

    # No sense doing any extra work
    return if message_rejected();

    use Net::LDAP;
    $ldap = Net::LDAP->new ( "localhost" ) or die "$@";

    $mesg = $ldap->bind ( version => 3 );          # use for searches

    #$mesg = $ldap->bind ( "$userToAuthenticate",
    #                       password => "$passwd",
    #                       version => 3 );          # use for changes/edits

    # see your LDAP administrator for information concerning the
    # user authentication setup at your site.

    sub LDAPsearch {
        my ($ldap,$searchString,$attrs,$base) = @_;

        # if they don't pass a base... set it for them

        if (!$base ) { $base = "dc=root"; }

        # if they don't pass an array of attributes...
        # set up something for them

        if (!$attrs ) { $attrs = [ 'cn','mail' ]; }

        my $result = $ldap->search ( base    => "$base",
                                scope   => "sub",
                                filter  => "$searchString",
                                attrs   =>  $attrs
                              );
    }

    sub LDAPsearch_results {
        my ($searchString,$attrs) = @_;
        my $result = LDAPsearch ($ldap, $searchString,$attrs);

        my @entries = $result->entries;

        my $entr;
        foreach $entr ( @entries ) {
            my $attr;
            foreach $attr ( sort $entr->attributes ) {
                # skip binary we can't handle
                next if ( $attr =~ /;binary$/ );
                return $entr->get_value ( $attr );
                }
            }
        }


    sub filter_ARCHIVE {
        # rewrite and remove domain lookup loop, search on sendmailMTAClassName and if result archive
        my ($archive_domain,$archive_email,$archive_user,$direction) = @_;
        $ldap_search_str = "(&(sendmailMTAClassValue=$archive_domain)(sendmailMTAClassName=archive_domains)(sendmailMTACluster=$sendmailMTACluster))";
        my $archive_on = LDAPsearch_results ($ldap_search_str,['sendmailMTAClassName']);

        if ($archive_on) {
                $searchString = "(|(mail=$archive_email)(mailRoutingAddress=$archive_email))";
                my $archive_uid = LDAPsearch_results ($searchString,['uid']);
            if ($archive_uid) {
                $archiveaddr = $archive_uid . '@archive.' . $archive_domain;
                add_recipient ($archiveaddr);
                $archive_msg = "archived $LocalHostName for $archive_email";
                action_add_header("X-PKFArchive",$archive_msg);
                }
            }
        }


    # save on dns lookups
    #$archive_server01 = inet_ntoa(inet_aton('archive01.domain.co.za')); 
    #$archive_server02 = inet_ntoa(inet_aton('archive01.domain.co.za')); 

    $archive_server01 = "192.168.60.21";
    $archive_server02 = "192.168.60.22";

    if (($RelayAddr ne $archive_server01) && ($RelayAddr ne $archive_server02)) {
        my $stripped_recip;
        my $recip_user;
        my $recip_domain;
        my $recip_archive_domain;
        my $recip;

        foreach $recip (@Recipients) {
            $stripped_recip = $recip;
            $stripped_recip =~ tr/<>//d;
            $stripped_recip = lc $stripped_recip;
            $recip_user = $stripped_recip;
            $recip_user =~ s/(^.*)\@.*/$1/;
            $recip_domain = $stripped_recip;
            $recip_domain =~ s/.*\@(.*$)/$1/;
            if ($recip_user =~ /_at_/i) {
                $recip_archive_domain = $recip_user;
                $recip_archive_domain =~ s/.*\_at_(.*$)/$1/;
                }
            else {
                $recip_archive_domain = $recip_domain;
                }
            #$recip_fulladdr = $recip_user . '@' . $recip_domain;
            &filter_ARCHIVE ($recip_archive_domain,$stripped_recip,$recip_user,"recipient");
            }

        my $stripped_sender;
        my $sender_user;
        my $sender_domain;

        $stripped_sender = $Sender;
        $stripped_sender =~ tr/<>//d;
        $stripped_sender = lc $stripped_sender;
        $sender_user = $stripped_sender;
        $sender_user =~ s/(^.*)\@.*/$1/;
        $sender_domain = $stripped_sender;
        $sender_domain =~ s/.*\@(.*$)/$1/;
        #$sender_fulladdr = $sender_user . '@' . $sender_domain;
        &filter_ARCHIVE ($sender_domain,$stripped_sender,$sender_user,"sender");
    }


    # I HATE HTML MAIL!  If there's a multipart/alternative with both
    # text/plain and text/html parts, nuke the text/html.  Thanks for
    # wasting our disk space and bandwidth...

    # If you want to strip out HTML parts if there is a corresponding
    # plain-text part, uncomment the next line.
    # remove_redundant_html_parts($entity);

    # md_graphdefang_log('mail_in');

    # Deal with malformed MIME.
    # Some viruses produce malformed MIME messages that are misinterpreted
    # by mail clients.  They also might slip under the radar of MIMEDefang.
    # If you are worried about this, you should canonicalize all
    # e-mail by uncommenting the action_rebuild() line.  This will
    # force _all_ messages to be reconstructed as valid MIME.  It will
    # increase the load on your server, and might break messages produced
    # by marginal software.  Your call.

    # action_rebuild();
}


# DO NOT delete the next line, or Perl will complain.
1;