#!/usr/bin/perl -w
#
###############################################################################
# !!!NOTE!!!
# 
# This is not being maintained within the Anomy tree, please check the 
# author's web site for the most recent version.  This one was downloaded
# from http://advosys.ca/papers/filter-misc/tnef2multipart.pl on 30.04.2003.
#
###############################################################################
#
# tnef2multipart.pl v0.02
# 
# Convert an MS Outlook TNEF attachment bundle ("winmail.dat")
# into a standard MIME multipart/mixed section. 
#
# For use with Anomy Sanitizer 1.56+ (http://mailtools.anomy.net/)
# 
#    Copyright 2003 Advosys Consulting Inc., Ottawa
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#
# USAGE:
#
# Use this as the scanner for file name "winmail.dat"
# For example, in your anomy.conf:
#    file_list_1 = (?i)(winmail.dat)
#    file_list_2_policy = accept:drop:drop:drop
#    file_list_2_scanner = 0:::/usr/local/bin/tnef2multipart.pl %FILENAME
#
# Requires the following Perl modules:
# 	MIME::Entity	
# 	MailTools
# 	IO::Stringy
# 	LWP::MediaTypes
# 	Convert::TNEF
#
# Changelog:
#   v0.01 Initial write
#   v0.02 Security: unset PATH and disallow spaces in TNEF filenames

# File locations
# (CHANGE AS REQUIRED TO MATCH YOUR SERVER)
my $ANOMY = '/usr/local/smtpfilter/anomy';
my $ANOMY_CONF = '/usr/local/smtpfilter/anomy.conf';
my $SPOOLDIR = '/var/spool/filter'; # Temp directory to use
my $typesfile = '/etc/mime.types';	# Location of your system's mime.types file

# ---------------------------------------
# Few user servicable parts below

use strict;
use Convert::TNEF;
use MIME::Entity;
use LWP::MediaTypes qw(guess_media_type);

# Make PATH safer:
$ENV{'PATH'} = $SPOOLDIR;

# Grab name of TNEF file to process:
my $tneffile = shift;

die("Usage: tnef2multipart <filename>\n") unless $tneffile;
die("Can't open $tneffile for reading: $!\n") unless -f $tneffile;

$ANOMY .= '/bin/sanitizer.pl';

# Create a temp dir:
my $tempdir = "$SPOOLDIR/tnef-$$"; 	# Where to extract each TNEF part
mkdir $tempdir or die("Can't create directory $tempdir: $!\n"); 

my $tnef = Convert::TNEF->read_in($tneffile) or die $Convert::TNEF::errstr;

my @files = ();
for ($tnef->attachments) {
	my $fname = "$tempdir/" . sanitize( $_->longname );
	push @files, $fname;
	open(OUTFILE,">$fname") or die "Can't write attachment: $!\n";
	print OUTFILE $_->data;
	close OUTFILE;
}
# Cleanup:
$tnef->purge;

# Create a new multipart/mixed MIME file:
my $top = MIME::Entity->build(Type =>"multipart/mixed");

# Improve LWP's MIME type guessing by adding system's mime.types:
LWP::MediaTypes->read_media_types($typesfile);

for my $file ( @files ) {
	my $type = guess_media_type($file);
	$top->attach(
		Path		=> $file,
		Type		=> $type,
		Disposition	=> "attachment",
		Encoding	=> "Base64"
	);
}

# Filter the MIME file with Anomy Sanitizer again, to apply security policy to
# files that were formerly hidden inside the TNEF:

# Quick 'n' dirty way: open a pipe to the sanitizer script:
open(SAN,"|$ANOMY $ANOMY_CONF > $SPOOLDIR/mime-$$") or die "Can't pipe to $ANOMY: $!\n";
$top->print(\*SAN) or die "Error piping to $ANOMY: $!\n";
close SAN;

# Cleanup:
unlink @files;
rmdir $tempdir;
unlink $tneffile;

# Tell Anomy Sanitizer about the conversion:
print "Anomy-FileScan-Description: Converted to MIME from the original TNEF file\n";
print "Anomy-FileScan-NewName: mime-$$\n";
print "Anomy-FileScan-NewFile: $SPOOLDIR/mime-$$\n";
print "Anomy-FileScan-NewType: multipart/mixed\n";
print "Anomy-FileScan-NewEnc: binary\n\n";

exit 0;


sub sanitize {
# Replace potentially nasty characters from input
	my $param = shift;
	my $ok_chars = 'a-zA-Z0-9._-';
	$param =~ s/[^$ok_chars]/_/go;
	return $param;
}
