# -*- Perl -*-
#***********************************************************************
#
# Test filter.  Tests most MIMEDefang actions.
#
# Copyright (C) 2000 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$
#***********************************************************************

#***********************************************************************
# Set administrator's name 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'
#***********************************************************************
$Administrator = 'postmaster@localhost';

#***********************************************************************
# 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 = 'mailer-daemon@localhost';

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

# Set the next one if your mail client cannot handle nested multipart
# messages
$Stupidity{"flatten"} = 1;

# Set the next one if your mail client cannot handle multiple "inline"
# parts (*cough* Exchange *cough* Outlook)
$Stupidity{"NoMultipleInlines"} = 1;

sub filter_begin {
    if (stream_by_domain()) {
	return;
    }
    my($recip);
    foreach $recip (@Recipients) {
	if ($recip =~ /nosuchperson/) {
	    delete_recipient($recip);
	    add_recipient('dfs@roaringpenguin.com');
	}
    }
    if ($SuspiciousCharsInHeaders) {
	print STDERR "SUSPICIOUS CHARACTERS IN HEADERS\n";
    }

    action_rebuild();
    print STDERR "This should be logged at debug level\n";
    my($hits, $req, $names, $report) = spam_assassin_check();
    $Boilerplate = "Boilerplate for domain: $Domain\nhits=$hits\nreq=$req\nnames=$names\nreport=$report\n";
}

#***********************************************************************
# %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
#***********************************************************************
sub filter {
    my($entity, $fname, $ext, $type) = @_;

    # For convenience, compute lower-case versions of filename and extension
    my($lc_fname) = $fname;
    my($lc_ext) = $ext;

    my($head) = $entity->head;
    my($junk);

    $junk = $head->get('Content-type', 0);
    print STDERR "get Content-type: $junk\n";
    $junk = $head->get('Content-description', 0);
    print STDERR "get Content-description: $junk\n";
    $lc_fname =~ tr/A-Z/a-z/;
    $lc_ext =~ tr/A-Z/a-z/;

    ####################################################################
    #                                                                  #
    #                      Filter rules follow                         #
    #                                                                  #
    ####################################################################

    print STDERR "Filter: fname='$fname', ext='$ext', type='$type'\n";
    #-------------------------------------------------------------------
    # Quarantine viruses
    #-------------------------------------------------------------------
    if (entity_contains_virus_filescan($entity)) {
	return action_quarantine($entity, "Virus detected - $VirusScannerMessages");
    }

    #-------------------------------------------------------------------
    # tests
    #-------------------------------------------------------------------
    if ($lc_fname =~ /action_accept_with_warning/) {
	return action_accept_with_warning("accept with warning test");
    }
    if ($lc_fname =~ /action_resend/) {
	# Resend only if original message was to dfs@shishi.roaringpenguin.com
	if ($Recipients[0] eq '<dfs@shishi.roaringpenguin.com>') {
	    resend_message('dfs@roaringpenguin.com', 'webmaster@roaringpenguin.com');
	    return action_discard();
	}
    }

    if ($lc_fname =~ /action_replace_with_url/) {
	return action_replace_with_url($entity,
				       "/home/httpd/html/parts",
				       "http://localhost/parts",
				       "The part was too large.  It was removed from this message, but is accessible\nat the following link:\n\n\t_URL_");
    }
    if ($lc_fname =~ /action_accept/) {
	action_add_header("X-Added-Header", "I chose to accept you");
	return action_accept();
    }
    if ($lc_fname =~ /action_drop_with_warning/) {
	return action_drop_with_warning("drop with warning test");
    }

    # Ensure that multiplexor kills filter if it's too busy
    if ($lc_fname =~ /test_busy_kill/) {
	while(1) {
	}
    }

    if ($lc_fname =~ /action_drop/) {
	# Test action_notify_sender here.
	action_notify_sender("The attachment '$fname' was dropped.\n");
	return action_drop();
    }
    if ($lc_fname =~ /action_defang/) {
	return action_defang($entity, "", "", "application/octet-stream");
    }
    if ($lc_fname =~ /action_quarantine/) {
	action_add_header("X-Quarantined", "Because I don't like you");
	action_quarantine_entire_message();
	return action_quarantine($entity, "action_quarantine test");
    }
    if ($lc_fname =~ /action_bounce/) {
	return action_bounce("Bounce test");
    }
    if ($lc_fname =~ /action_tempfail/) {
	return action_tempfail("Test of tempfail action");
    }

    # Test that we tempfail a message if the filter dies
    if ($lc_fname =~ /action_filterexit/) {
	print STDERR "Deliberately exiting from filter to test tempfail\n";
	# Pretend to multiplexor that everything's cool
	if ($ServerMode) {
	    $| = 1;
	    print "ok\n";
	    $| = 0;
	    # Let MUX do its stuff before we exit...
	    sleep(4);
	}
	exit(32);
    }

    if ($lc_fname =~ /action_discard/) {
	action_notify_administrator("Discarding message; admin should get this");
	return action_discard();
    }

    if ($type eq "text/html") {
	return anomy_clean_html($entity);
    }

    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";
}

sub filter_end {
    my($entity) = @_;
    append_boilerplate($entity, "$Boilerplate");
}

# Test host rejection
sub filter_relay {
    my($hostip, $hostname) = @_;
    if ($hostname eq "shishi.roaringpenguin.com") {
	return (0, "Sorry, shishi, you are blacklisted");
    }
    return (1, "ok");
}

sub filter_sender {
    my($sender) = @_;
    if ($sender =~ /^<?blacklisted\@roaringpenguin.com>?$/i) {
	return (0, 'Sorry, <blacklisted@roaringpenguin.com>, you are blacklisted');
    }
    return (1, "ok");
}

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