LISTING 1: MessageFilter.pl

# Begin Callout A
#<SCRIPT LANGUAGE="PerlScript">
# End Callout A

use Win32::OLE qw( in with );
use vars qw( $VERSION $LOG_PATH
  @UNWANTED_SUBJECTS_REGEX 
  @UNWANTED_EXTENSIONS_REGEX $S_OK
  $cdoRunNextSink $cdoSkipRemainingSinks
  $cdoStatAbortDelivery $cdoStatBadMail  );
$VERSION = 20040217;

# Begin Callout B
#$LOG_PATH  = "C:\\MessageFilter.log";
# End Callout B

# Begin Callout C
@UNWANTED_SUBJECTS_REGEX = map{ qr/$_/i }
  ("SoBig", "Your Application", "Re: Details", "That Movie",
    "Wicked Screensaver", "Re: Approved", ); 

my @UNWANTED_EXTENSIONS = qw(
  exe com pif scr bat cmd vbs zip );
my $UNWANTED_EXTENSIONS_STRING =
  join( "|", @UNWANTED_EXTENSIONS );
$UNWANTED_EXTENSIONS_REGEX =
  qr/\.(?:$UNWANTED_EXTENSIONS_STRING)$/i;
# End Callout C
   
# Begin Callout D
BEGIN COMMENT
# Define CDO constants.
END COMMENT
$S_OK = 0x00000000;
$cdoRunNextSink = 0;
$cdoSkipRemainingSinks = 1;
$cdoStatAbortDelivery = 2;
$cdoStatBadMail = 3;
# End Callout D

sub ISMTPOnArrival_OnArrival
{
# Begin Callout E
  my( $Message, $EventStatus ) = @_;
# End Callout E

BEGIN COMMENT
  # Set the default return value.
END COMMENT
my $Result = $cdoRunNextSink;
  my $Subject = $Message->{Subject};

# Begin Callout F
  if( IsSubjectExcluded( $Message ) || IsExtensionExcluded(
    $Message ) )
  {
    my $Fields = $Message->{EnvelopeFields};
BEGIN COMMENT
    # Mark this message as bad and tell script to abort delivery.
END COMMENT
    $Fields->Item("http://schemas.microsoft.com/cdo/smtpenvelope/
      messagestatus")->{Value} = $cdoStatAbortDelivery;
BEGIN COMMENT
    # Update the field's new values.
END COMMENT
    $Fields->Update();
BEGIN COMMENT
    # This message is bad, so tell other sinks not to process it.
END COMMENT
    $Result = $cdoSkipRemainingSinks;
    Log( "Discarded message from '$Message->{From}'
      with subject '$Message->{Subject}'." );
  }
# End Callout F
BEGIN COMMENT
  # This code fails with Perl, but let's include it anyway to be a
  # good programmer!
END COMMENT
  $_[1] = $Result;
  return;
}

sub IsSubjectExcluded
{
  my( $MessageObject ) = @_;
# Begin Callout G
  my $Subject = $MessageObject->{Subject};
  map{ return( 1 ) if( $Subject =~ $_ ); }
    @UNWANTED_SUBJECTS_REGEX;
# End Callout G
  return( 0 );
}

sub IsExtensionExcluded
{
  my( $MessageObject ) = @_;
# Begin Callout H
  my $Attachments = $MessageObject->{Attachments};
  if( 0 < $Attachments->{Count} )
  {
BEGIN COMMENT
    # Note that all attachments are contained in body parts. The
    # collection object exposes the IBodyParts interface.
END COMMENT
    foreach my $Body ( in( $Attachments ) )
    {
      my $FileName = $Body->{Filename};
      return( 1 ) if( $FileName =~
        $UNWANTED_EXTENSIONS_REGEX );
    }
  }
  return( 0 );
# End Callout H
}

sub SendToLog
{
	my( $Message ) = @_;
# Begin Callout I	
  if( ! fileno( LOG ) )
  {
    if( open( LOG, ">> $LOG_PATH" ) )
    {
      my $BackupHandle = select( LOG );
BEGIN COMMENT
      # Set the autoflush flag so that data sent to the log file isn't buffered.
      # This isn't very efficient, but it's very useful during debugging.
END COMMENT
      $| = 1;
      select( $BackupHandle );
    }
  }
  print LOG "$Message\n" if( fileno( LOG ) );
# End Callout I
  return;
}	

sub CloseLog
{
  close( LOG ) if( fileno( LOG ) );
}

sub Log
{
  my( $Message ) = @_;
  SendToLog( "[" . localtime() . "] $Message\n" );
}

END
{
  CloseLog();
}
# Begin Callout J
#</SCRIPT>
# End Callout J