#!/usr/bin/perl

#
# mailscanner.pl
#
# Adapted from example code in the MIME-Tools distribution.
#

require 5.001;

#
# Set to 1 for debug output:
my $debug = 0;

#
# Disallowed extensions:
my @disallowed_extensions = (".exe", ".shs");

#
# File extensions regarded as archives:
my @zipextensionlist = (".zip");

#
# Number of recursions into archive attachments:
my $maxdepth = 5;
my $zipdepth = 0;

#
# Directory for temporary files:
my $TMPDIR = "/tmp";

use strict;
use vars qw($Msgno);

use MIME::Parser;
use Getopt::Std;
use File::Path; # for rmtree()

#------------------------------------------------------------
# make_msg - make and return the name of a msgXXX directory
#------------------------------------------------------------
$Msgno = 0;
my $zipno = 0;

sub make_msg {
    while (-d "$TMPDIR/msg$Msgno") { 
	++$Msgno;
	die "self-imposed limit reached" if $Msgno == 1024;
    }
    mkdir "$TMPDIR/msg$Msgno",0755 or die "couldn't make msg$Msgno: $!";
    "$TMPDIR/msg$Msgno";
}

#------------------------------------------------------------
# check_entity - Check for disallowed file attachments.
#------------------------------------------------------------
sub check_entity
{
    my $ent = shift;
    my @parts = $ent->parts;
    my $ext;

    if (@parts)
    {        # multipart...
        map { check_entity($_) } @parts;
    }
    else
    {               # single part...
	    #print "    Part: ", $ent->bodyhandle->path, 
	    #      " (", scalar($ent->head->mime_type), ")\n";
	    foreach $ext (@disallowed_extensions)
        {
			if(!$ent->bodyhandle)
			{ return; }

            if ( $ent->bodyhandle->path =~ m/.zip$/ )
            {
                if(check_zip($ent->bodyhandle->path))
                { reject_mail("ZIP Attachment containing disallowed file."); }
            }

            if ( $ent->bodyhandle->path =~ m/$ext$/ )
            { reject_mail("$ext Attachment found"); }
        }
    }
}


#
# Create temp subdirectory:
sub mk_tempdir
{
    while (-d "$TMPDIR/msg$Msgno/zip$zipno") { 
	++$zipno;
	die "Cannot create temp dir for unpacking ZIP: self-imposed limit reached" if $zipno == 1024;
    }
    mkdir "$TMPDIR/msg$Msgno/zip$zipno",0755 or die "couldn't make $TMPDIR/msg$Msgno/zip$zipno: $!";
    "$TMPDIR/msg$Msgno/zip$zipno";
}


#
# Escape some shell characters.
sub shellescape
{
	my $arg = shift;

	$arg =~ s/([%; ])/\\$1/g;

	$arg;
}


#
# Recursivly check contents of ZIP file:
sub check_zip
{
	#print ("check_zip() called\n");

	my @zipcontentlist;

	$zipdepth++;
	if($zipdepth > $maxdepth)
	{
		# Reject Mail: Maximum recursion depth reached.
		reject_mail("Maximum recursion level reached.");
	}
	
    my $zipfile = shift;

	# List ZIP File:
	my $zipfilename = shellescape($zipfile);
	
	open ZIPFILE, "unzip -l $zipfilename |";

	while(<ZIPFILE>)
	{
		foreach my $zipext (@zipextensionlist)
		{
			# Skip first line with name of THIS zip file:
			if( m/^Archive/ || m/[ \t]*\d+[\t ]+\d+ files*$/ )
			{ next; }
			if( m/$zipext$/ )
			{
				# Extract filename:
				#print "Line: $_\n";
				my $zipcontentname = $_;
				$zipcontentname =~ s/[\t\d :-]+([\w\d \._]*)/\1/;
				#print "Found ZIP: $zipcontentname\n";
				push @zipcontentlist, $zipcontentname;
			}
		}

		foreach my $ext (@disallowed_extensions)
        {
            if ( m/$ext$/ )
            { reject_mail("$ext found in ZIP."); }
		}
	}

	close(ZIPFILE);

	# If ZIP inside ZIP:
	if(0+@zipcontentlist)
	{
		# Create temp directory for unpacking:
		my $zipdir = mk_tempdir();
		# Should work, as mk_tempdir() exits on error:
		chdir($zipdir);

		foreach my $zipentry (@zipcontentlist)
		{
			#print "recursive call: $zipentry\n";
			# Extract this entry:
			$zipentry = shellescape($zipentry);
			#system("unzip $zipfilename $zipentry 2>&1 >/dev/null");
			open UNZIP, "unzip -d $TMPDIR/msg$Msgno/zip$zipno $zipfilename $zipentry 2>&1 >/dev/null |";
			while(<UNZIP>)
			{ }
			close(UNZIP);
			# Recursivly call check_zip():
			check_zip("$TMPDIR/msg$Msgno/zip$zipno/$zipentry");
			# upon return, remove this zip:
			unlink("$TMPDIR/msg$Msgno/zip$zipno/$zipentry");
		}
	}
    
    return 0;
}

#
# Reject Mail by printing 'reject' to stdout'
sub reject_mail
{
	if($debug)
	{
		my $reason = shift;
		print "$reason at recursion level $zipdepth\n";
	}

	# Move back to save territory:
	chdir($TMPDIR);
    print ("reject");
	# Remove temp dirs:
    cleanup();
    exit(0);
}

#
# Print accept to stdout, indicating 'Mail OK'
sub accept_mail
{
    print ("accept");
    cleanup();
    exit(0);
}

#
# Remove the temporary files:
sub cleanup
{
    rmtree("$TMPDIR/msg$Msgno");
}


#------------------------------------------------------------
# main
#------------------------------------------------------------
sub main {
    my $file;
    my $entity;

    # Sanity:
    (-w "$TMPDIR") or die "$TMPDIR not writable.";
    
    # Go through messages:
    @ARGV or unshift @ARGV, "-";
    while (defined($file = shift @ARGV)) {

	my $msgdir = make_msg();
	#print "Message: $msgdir ($file)\n";

    # Register cleanup() as exit handler:
    END { cleanup(); }

	# Create a new parser object:
	my $parser = new MIME::Parser;
	### $parser->parse_nested_messages('REPLACE');
    
	# Optional: set up parameters that will affect how it extracts 
	#   documents from the input stream:
	$parser->output_dir($msgdir);
    
	# Parse an input stream:
	open FILE, $file or die "couldn't open $file";
	$entity = $parser->read(\*FILE) or 
	    print STDERR "Couldn't parse MIME in $file; continuing...\n";
	close FILE;

	# Congratulations: you now have a (possibly multipart) MIME entity!
	check_entity($entity) if $entity;
	### $entity->dump_skeleton if $entity;
    }

	# If any non-acceptable content was found, the program has terminated
	# before reaching this point, so here we can (safely ?!?) accept the mail:
	accept_mail();
    1;
}

exit (&main ? 0 : -1);
#------------------------------------------------------------
1;