#!/usr/bin/perl
#
# Rached Blili, Jan 2004
#
# This is a script which searches for those stupid
# winmail.dat attachments that outlook/exchange sticks
# in messages and tries to extract the files hidden
# inside, if any.
# The message is then forwarded with the new attachments.
#
# I hope.
#
# If the -f flag is specified on the command line, then
# the script assumes that it is being called as a filter
# and not a delivery agent.  The result is simply output
# to standard out in that case.
#
#############################################################################
# COPYRIGHT NOTICE
# Copyright 2002,2003,2004 Rached Blili (striker@Dread.net) All Rights Reserved
#
#  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.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#############################################################################

# CONFIGURATION
# Set these as appropriate.
$username="BLANK";
$spooldir="/var/mail";
$spoolfile="$spooldir/$username";
$lockfile="$spooldir/$username.lock";

$mimencode = "/usr/local/bin/mimencode";
$mimedecode = "/usr/local/bin/mimencode -u";
#$tnefdecode = "/usr/local/bin/tnef";
$tnefdecode = "/usr/local/bin/ytnef";

# Check for enhanced tnef decoder by Yerase
$ytnef=0;
@output=grep(/Yerase/,`$tnefdecode -h`);
if (@output > 0) {
	$ytnef=1;
	# Matthew Clarke (Matthew_Clarke@mindlink.bc.ca)
	# clamat -- check for ytnef v2.x
	# clamat -- NDY:  this will break if ever ytnef v3 comes out
	if (grep(/ v2\./,@output)) {
		$ytnef=2;
	}
}

$tmpdir="/tmp/".time();

# END CONFIGURATION
%MIMETable = &MakeMIMETable; # The MIME Table is defined at the bottom.
# No user serviceable parts below.

# There is a small chance that if two very large messages are received
# within a fraction of a second of each other, they will both be given
# the same tmpdir name and be trying to use it at the same time.
# Let's just avoid that, shall we? (Thanks to Greg <payne@aijalon.net>)
while (-e $tmpdir) {
   $tmpdir .= "x";
}
mkdir($tmpdir);
$newattachdir="$tmpdir/attach";

$error=0;
$I_am_a_filter=0;
$stage=0;
$curr_line="";
$prev_line="";
$continued_from="";
$content_type="";
$content_length=0;
$hasboundary=0;
$boundary="";
$winmail=0;
$partnum=0;
@parts=();


# Stupid simple arg checking...
if ($ARGV[0]) {
	if ($ARGV[0] eq "-f") {
		$I_am_a_filter=1;
	}
}
elsif ($username eq "BLANK") {
	print "tnefclean is not configured.  Edit tnefclean.pl.\n";
	exit 1;
}

	
# This script reads email from standard input
open(BACKUP,">$tmpdir/orig.message"); # keep a backup of the original
while (<STDIN>) {    # Split the message into its parts on the fly.
   $curr_line=$_;
   print BACKUP $curr_line;

   # We need to know whether this email contains any winmail files 
   # so we can take a shortcut when it doesn't.(Thanks to Greg
   # <payne@aijalon.net>)
   # This is a rather weak check since we don't know whether the string
   # was found in a MIME header or not.  But so what.  If we get a false
   # positive here, all that happens is we don't optimize performace quite
   # as much as we could.

   # Commented out in favour of a stronger test.
   #if ($line =~ /name="winmail[0-9]*\.dat[0-9]*"/) { # AHA! Found one
   #  $winmail=1;
   #} 
   
   # As it turns out, TNEF attachments are not always called winmail.dat
   if ($curr_line =~ /^content-type: application\/ms-tnef/i) {
     $winmail=1;
   }

   if ($stage == 0) {
     open(OUTFILE,">$tmpdir/header");
     $stage=1;
   }
   if ($stage == 1) {
     if ($curr_line =~ /^content-type/i) { # Looking for content-type header
	$content_type=$curr_line;
	print OUTFILE "CONTENT_TYPE\n";  # We'll clean this up later.
     }
     elsif ($curr_line =~ /^[ \t]+.+/) { #Grab continued lines.
	if ($continued_from eq "") {
	   $continued_from=$prev_line;
	}
	if ($continued_from =~ /^content-type/i) {
	   $content_type .= $curr_line;
	}
	else {
	   print OUTFILE $curr_line;
	}
     }
     elsif ($curr_line =~ /^content-length:/i) {
	print OUTFILE "CONTENT_LENGTH\n";  # We'll clean this up later.
     }
     elsif ($curr_line =~ /^\s*$/) { # This marks the end of the header.
	print OUTFILE "X-TNEFCLEAN\n"; # Put our little mark on the header.
	print OUTFILE $curr_line;
	close(OUTFILE);
	open(OUTFILE,">$tmpdir/body"); # move on to the body part.
	$stage=2;
	if ($content_type ne "") {  # Get ready for later.
	  chop($content_type);
	  if ($content_type =~ /.*boundary=.*/i ) {
		($junk,$boundary)=split(/boundary=/i,$content_type);
		$boundary =~ s/"//g;  # Now we have our boundary string.
		$hasboundary=1;
	  }
	}
     }
     else {
	print OUTFILE $curr_line;
     }
     if (($curr_line !~ /^[ \t]+.+/) && ($prev_line =~ /^[ \t]+.+/)) {
	$continued_from="";  # Done reading continued lines.  Reset.
     }
   }
   elsif ($stage == 2) { # Post-header
     if ($hasboundary) { # Only do this if the message is multipart MIME
     	if ($curr_line =~ /^--$boundary$/) {
	   close(OUTFILE);
	   $partnum++;  # Each part in its own file.
	   open(OUTFILE,">$tmpdir/part$partnum"); 
	   $parts[$partnum -1] = "part$partnum";
     	} 
	# Ryan Kirkpatrick (linux@rkirkpat.net)
	elsif ($curr_line =~ /^--$boundary--$/) { ; } # Dont print
     	else {
	   print OUTFILE $curr_line;
     	}
     }
     else { # This gets called if this is a plain jane message.
	print OUTFILE $curr_line;
     }
   }
   $prev_line=$curr_line;
}
close(OUTFILE); # Whatever OUTFILE happens to be when the loop terminates.
close(BACKUP);

# Skip the rest of this script if we either have no attachments or no
# winmail.dat. (Thanks to Greg <payne@aijalon.net>)
# UNLESS the message body itself is TNEF encoded (Sound unlikely?  That's
# what I thought until I got a bug report!)
if ((!$partnum) || (!$winmail)) {
   if (! $winmail) {
      Deliver("$tmpdir/orig.message");
      foreach $part (@parts) {
        if ( -e "$tmpdir/$part") {
         unlink("$tmpdir/$part");
        }
      }
      unlink("$tmpdir/body"); # clamat -- bugfix
      unlink("$tmpdir/header");       # clamat -- bugfix
      rmdir($tmpdir);
      exit;
   }
   else { # This message is not multipart but IS tnef encoded.  
      open(OUTFILE,">$tmpdir/part1");
      print OUTFILE "$content_type\n\n";
      close(OUTFILE);
      system("cat $tmpdir/body >> $tmpdir/part1");
      if ($rc != 0 ) {
	$error++;
      }
      unlink("$tmpdir/body");
      $parts[0]="part1";
   }
}
   
foreach $part (@parts) {
   if ( -e "$tmpdir/$part" ) {  # Sanity check.
     $winmail=0;
     open(PART,"<$tmpdir/$part");
     $done=0;
     do {
		$line = <PART>;
		if ($line =~ /^\s*$/) { # Read till the end of the MIME header.
		   $done=1;
		}
		# Commented out in favour of a stronger test.
		#elsif ($line =~ /name="winmail[0-9]*\.dat[0-9]*"/) { # AHA! Found one.
		#   $winmail=1;
		#}	
		# As it turns out, TNEF attachments are not always called winmail.dat
		elsif ($line =~ /^content-type: application\/ms-tnef/i) {
		   $winmail=1;
		}

		elsif ($line eq <EOF>) { # Prevent infinite loops.
		   $done=1;
		}
     } until ($done);
     $partbody= $. + 1;
     close(PART);
     if ($winmail) {
	  	# Remove MIME encapsulation
	  	system("tail +$partbody $tmpdir/$part|$mimedecode>$tmpdir/winmail.dat");
	  	$rc = $? >> 8;
	  	if ($rc != 0 ) {
			$error++;
	  	}
	  	# Must perform separate op to get file names with standard tnef 
	  	# decoder.
	  	if (! $ytnef ) {
			# Get the list of files in the winmail.dat
			@files=`$tnefdecode -f $tmpdir/winmail.dat -t`;
			$rc = $? >> 8;
			if ($rc != 0 ) {
				$error++;
			}
			# Okie Dokie.  Now we extract all the crap.
	  		mkdir("$newattachdir");
			system("$tnefdecode -f $tmpdir/winmail.dat -C $newattachdir");
			$rc = $? >> 8;
			if ($rc != 0 ) {
				$error++;
			}
	  	}
	  	else {
			# Okie Dokie.  Now we extract all the crap.
	  		mkdir("$newattachdir");
			# clamat -- ytnef 2.x does not have a -L flag
			if ($ytnef == 2) {
				@files=`$tnefdecode -f $newattachdir $tmpdir/winmail.dat`;
				# Matt Skerritt
				# (mattsk@allstaff.net.au)
				use File::Basename;
				for (@files) {
					$_ = basename($_);
				}
			}
			else {
				@files=`$tnefdecode -L -f $newattachdir $tmpdir/winmail.dat`;
			}
			$rc = $? >> 8;
			if ($rc < 0 ) {
				$error++;
			}
	  	}
	  	# Get rid of the temporary files so we only have the new
	  	unlink("$tmpdir/$part");
	  	unlink("$tmpdir/winmail.dat");
	
	  	# Now we create MIME attachments from the extracted files.
	  	foreach $fn (@files) {
	  		chop($fn);
	  		open(MIMEFILE,">$tmpdir/$fn");
	
			$mimecode="";
			$mimecode=&GuessMimeType($fn);
		  	print MIMEFILE "Content-Type: $mimecode;\n";
		  	print MIMEFILE "	name=\"$fn\"\n";
		  	print MIMEFILE "Content-Disposition: attachment; filename=\"$fn\"\n";
		  	print MIMEFILE "Content-Transfer-Encoding: base64\n\n";
		  	close(MIMEFILE);
		  	system("$mimencode \"$newattachdir/$fn\" >> \"$tmpdir/$fn\"");
		  	$rc = $? >> 8;
		  	if ($rc != 0 ) {
				$error++;
		  	}
		  	unlink("$newattachdir/$fn");  # Get rid of the unencoded version
	 	}
	  	rmdir("$newattachdir");
	  }
     if ($partbody < 2) { # Sometimes you get empty attachments.
		unlink("$tmpdir/$part");
     }
  }
}

# Now we put the message together

$msgfile="$$.msg";
$partnum=0;

# First we build the body:
# $tmpdir/body already contains the message body (non-attached)
# if there was one.  So we just append to that.
foreach $part (@parts) {
   # We may have deleted some parts, so check.
   if ( (-e "$tmpdir/$part") && ($part ne "") ) { 
     $partnum++;
     system("echo \"--$boundary\" >> $tmpdir/body");
     $rc = $? >> 8;
     if ($rc != 0 ) {
		$error++;
     }
     system("cat $tmpdir/$part >> $tmpdir/body");
     $rc = $? >> 8;
     if ($rc != 0 ) {
		$error++;
     }
     unlink("$tmpdir/$part"); # Don't need this anymore.
   }
}
foreach $fn (@files) { # These are the files extracted from winmail.dat if any.
   if ( (-e "$tmpdir/$fn") && ($fn ne "") ) {
     $partnum++;
     system("echo \"--$boundary\" >> $tmpdir/body");
     $rc = $? >> 8;
     if ($rc != 0 ) {
		$error++;
     }
     system("cat $tmpdir/\"$fn\" >> $tmpdir/body");
     $rc = $? >> 8;
     if ($rc != 0 ) {
		$error++;
     }
     unlink("$tmpdir/$fn");
   }
}

# We don't need a content-type header for messages with no
# attachments
if ($partnum == 0) {
   if ($content_type =~ /multipart\//i ) {
     $content_type="";
   }
}
elsif ($partnum == 1) {
   # At this point, it's possible that all our body contains
   # is a "this is a MIME-encoded message" type blurb followed
   # by a simple text attachment which contains the true body
   # of the message.  If that's the case, then let's cut out
   # the middle-man.  We'll use that one and only attachment's
   # MIME header as the content-type message header and get
   # rid of the preamble.
   @result=();
   @result=`head -4 $tmpdir/body`;
   if (grep(/$boundary/,@result)) { # The part starts almost immediately.
     open(BODY,"< $tmpdir/body");
     $line=<BODY>;
     if ($line =~ /.* mime .*/i) { # Try to check for the MIME blurb.
	$mark=0;
	$ct="";
	do {
	   $ct=<BODY>;
	} until (($ct =~ /^content-type:/i) || ($. > 6));
	$line=<BODY>;
	while (($line !~ /^\s*$/) && ($. < 15)) {
	   $ct .= $line;
	   $line=<BODY>;
	}
	$mark=$.;
	close(BODY);
	# Remember, we only want to do this if the attachment
	# is some sort of text attachment.
	if ($ct =~ /^content-type: text\//i) { 
	   $content_type=$ct;
	   chop($content_type);
	   system("tail +$mark $tmpdir/body > $tmpdir/body.new");
	   system("mv $tmpdir/body.new $tmpdir/body");
	   $partnum=0;
	}
     }	
   }
}

# If we have parts, we must append a part terminating
# boundary string to the body.
if ($partnum > 0 ) {
	open(BODY,">>$tmpdir/body");
	print BODY "--${boundary}--\n\n";
	close(BODY);
}
else {
	open(BODY,">>$tmpdir/body");
	print BODY "\n";
	close(BODY);
}	

# We are ready to take a measurement for the content-length
@filedata=stat("$tmpdir/body");
$content_length=$filedata[7];

# Alter the header
open(HEADER,"$tmpdir/header");
@header=<HEADER>;
close(HEADER);
unlink("$tmpdir/header"); # We have it in RAM.  We'll rewrite it soon.
foreach (@header) {
	if ($content_type ne "") {
		s/^CONTENT_TYPE.*$/$content_type/;
	}
	s/^CONTENT_LENGTH/Content-Length: $content_length/;
	s/^X-TNEFCLEAN/X-TNEFCLEAN: error=$error parts=$partnum/;
}
open(MSG,">$tmpdir/$msgfile");
print MSG @header;
close(MSG);


# Take the body we constructed earlier and append it to the
# message right after the header.
system("cat $tmpdir/body >> $tmpdir/$msgfile");
$rc = $? >> 8;
if ($rc != 0 ) {
	$error++;
}
unlink("$tmpdir/body");

if ($error > 0 ) {
   Deliver("$tmpdir/orig.message");
   foreach $part (@parts) {
     if ( -e "$tmpdir/$part") {
		unlink("$tmpdir/$part");
     }
   }
}
else {
	Deliver("$tmpdir/$msgfile");
}
rmdir($tmpdir);
exit;

sub Deliver {
   my $messagefile = shift;
   if ($I_am_a_filter) {
	open(MESSAGE,"<$messagefile");
	while (<MESSAGE>) {
		print; # Just print to standard output
	}
	close(MESSAGE);
   }
   else {
	# Alllllrighty then.  Let's deliver this puppy.
	use integer;
	# If the spool file is locked, sleep 0 to 10 seconds and retry
	while ( -e $lockfile ) {
		($num,$junk) = split(/\./,rand 10);
		sleep $num;
	}
	system("touch $lockfile");
	system("cat $messagefile >> $spoolfile");
	system("echo \"\" >> $spoolfile");
	unlink($lockfile);
   }
   unlink("$tmpdir/$msgfile");
   unlink("$tmpdir/orig.message");
}

sub GuessMimeType {

	#This may be unwise, but since we don't include fancy perl
	#modules that understand MIME, let's just do this on a
	#best-guess based on the file extension.
	my $filename = shift;
	my @fnparts = split(/\./,$filename);
	my $ext="unknown";
	my $mimetypestring = "application/unknown";

	if (@fnparts > 1) {
		$ext = $fnparts[@fnparts -1];	
	}

	$mimetypestring = $MIMETable{$ext};
	return($mimetypestring);
}

sub MakeMIMETable {

	my %MIMETable = qw(
		unknown	application/unknown
		hqx	application/mac-binhex40
		cpt	application/mac-compactpro
		doc	application/msword
		xls	application/vnd.ms-excel
		bin	application/octet-stream
		dms	application/octet-stream
		lha	application/octet-stream
		lzh	application/octet-stream
		exe	application/octet-stream
		class	application/octet-stream
		oda	application/oda
		pdf	application/pdf
		ai	application/postscript
		eps	application/postscript
		ps	application/postscript
		ppt	application/powerpoint
		rtf	application/rtf
		bcpio	application/x-bcpio
		vcd	application/x-cdlink
		cpio	application/x-cpio
		csh	application/x-csh
		dcr	application/x-director
		dir	application/x-director
		dxr	application/x-director
		dvi	application/x-dvi
		gtar	application/x-gtar
		hdf	application/x-hdf
		skp	application/x-koan
		skd	application/x-koan
		skt	application/x-koan
		skm	application/x-koan
		latex	application/x-latex
		mif	application/x-mif
		nc	application/x-netcdf
		cdf	application/x-netcdf
		sh	application/x-sh
		shar	application/x-shar
		sit	application/x-stuffit
		sv4cpio	application/x-sv4cpio
		sv4crc	application/x-sv4crc
		tar	application/x-tar
		tcl	application/x-tcl
		tex	application/x-tex
		texinfo	application/x-texinfo
		texi	application/x-texinfo
		t	application/x-troff
		tr	application/x-troff
		roff	application/x-troff
		man	application/x-troff-man
		me	application/x-troff-me
		ms	application/x-troff-ms
		ustar	application/x-ustar
		src	application/x-wais-source
		zip	application/zip
		au	audio/basic
		snd	audio/basic
		mid	audio/midi
		midi	audio/midi
		kar	audio/midi
		mpga	audio/mpeg
		mp2	audio/mpeg
		aif	audio/x-aiff
		aiff	audio/x-aiff
		aifc	audio/x-aiff
		ram	audio/x-pn-realaudio
		rm	audio/x-pn-realaudio
		ra	audio/x-pn-realaudio
		rpm	audio/x-pn-realaudio-plugin
		ra	audio/x-realaudio
		wav	audio/x-wav
		pdb	chemical/x-pdb
		xyz	chemical/x-pdb
		gif	image/gif
		ief	image/ief
		jpeg	image/jpeg
		jpg	image/jpeg
		jpe	image/jpeg
		png	image/png
		tiff	image/tiff
		tif	image/tiff
		ras	image/x-cmu-raster
		pnm	image/x-portable-anymap
		pbm	image/x-portable-bitmap
		pgm	image/x-portable-graymap
		ppm	image/x-portable-pixmap
		rgb	image/x-rgb
		xbm	image/x-xbitmap
		xpm	image/x-xpixmap
		xwd	image/x-xwindowdump
		vcf	text/calendar
		htm	text/html
		html	text/html
		txt	text/plain
		rtx	text/richtext
		tsv	text/tab-separated-values
		etx	text/x-setext
		sgml	text/x-sgml
		sgm	text/x-sgml
		mpeg	video/mpeg
		mpg	video/mpeg
		mpe	video/mpeg
		qt	video/quicktime
		mov	video/quicktime
		avi	video/x-msvideo
		movie	video/x-sgi-movie
		ice	x-conference/x-cooltalk
		wrl	x-world/x-vrml
		vrml	x-world/x-vrml
		);
	return(%MIMETable);
}