238 lines
		
	
	
		
			6.5 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			238 lines
		
	
	
		
			6.5 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
#!/usr/bin/perl -w
 | 
						|
=head1 NAME
 | 
						|
 | 
						|
tnef2mime
 | 
						|
 | 
						|
=head1 DESCRIPTION
 | 
						|
 | 
						|
Plugin that converts ms-tnef attachments (winmail.dat) and uuencoded attachments to MIME.
 | 
						|
 | 
						|
perl-Convert-TNEF, perl-IO-stringy, perl-File-MMagic and perl-MIME-tools are required.
 | 
						|
 | 
						|
=head1 AUTHOR
 | 
						|
 | 
						|
Michael Weinberger, neddix Stuttgart, 2005
 | 
						|
 | 
						|
=head1 LICENSE
 | 
						|
 | 
						|
GNU GPL (GNU General Public License)
 | 
						|
 | 
						|
 | 
						|
=cut
 | 
						|
use MIME::Parser;
 | 
						|
{
 | 
						|
# this is a dirty fix regarding this bug https://rt.cpan.org/Ticket/Display.html?id=97886
 | 
						|
# this way we can keep on usinhg this plugin waiting for the upstream fix
 | 
						|
# the no warnings avoid message in qpsmtpd log on every mails saying we override the sub.
 | 
						|
no warnings;
 | 
						|
*MIME::Parser::Filer::output_path = sub  {
 | 
						|
    my ($self, $head) = @_;
 | 
						|
 | 
						|
    ### Get the output directory:
 | 
						|
    my $dir = $self->output_dir($head);
 | 
						|
 | 
						|
    ### Get the output filename as UTF-8
 | 
						|
    my $fname = $head->recommended_filename;
 | 
						|
 | 
						|
    ### Can we use it:
 | 
						|
    if    (!defined($fname)) {
 | 
						|
        $self->debug("no filename recommended: synthesizing our own");
 | 
						|
        $fname = $self->output_filename($head);
 | 
						|
    }
 | 
						|
    elsif ($self->ignore_filename) {
 | 
						|
        $self->debug("ignoring all external filenames: synthesizing our own");
 | 
						|
        $fname = $self->output_filename($head);
 | 
						|
    }
 | 
						|
    elsif ($self->evil_filename($fname)) {
 | 
						|
 | 
						|
        ### Can we save it by just taking the last element?
 | 
						|
        my $ex = $self->exorcise_filename($fname);
 | 
						|
        if (defined($ex) and !$self->evil_filename($ex)) {
 | 
						|
            $self->whine("Provided filename '$fname' is regarded as evil, ",
 | 
						|
                         "but I was able to exorcise it and get something ",
 | 
						|
                         "usable.");
 | 
						|
            $fname = $ex;
 | 
						|
        }
 | 
						|
        else {
 | 
						|
            $self->whine("Provided filename '$fname' is regarded as evil; ",
 | 
						|
                         "I'm ignoring it and supplying my own.");
 | 
						|
            $fname = $self->output_filename($head);
 | 
						|
        }
 | 
						|
    }
 | 
						|
    $self->debug("planning to use '$fname'");
 | 
						|
 | 
						|
    #untaint dir and fname
 | 
						|
    $self->debug("it is our own");
 | 
						|
    $fname = ($fname =~ m/^([ \w_.:%-]+)$/ig) ? $1 : $self->output_filename($head);
 | 
						|
    ### Resolve collisions and return final path:
 | 
						|
    return $self->find_unused_path($dir, $fname);
 | 
						|
};
 | 
						|
}
 | 
						|
 | 
						|
use MIME::Entity;
 | 
						|
use MIME::Head;
 | 
						|
use File::MMagic;
 | 
						|
use Convert::TNEF;
 | 
						|
 | 
						|
my $parser;
 | 
						|
my $ent;
 | 
						|
my $tmpdir='/var/spool/qpsmtpd';
 | 
						|
my $count=0;
 | 
						|
my $foundtnef=0;
 | 
						|
my (@attachments, @blocked, @tnefs);
 | 
						|
 | 
						|
 | 
						|
sub register {
 | 
						|
  my ($self, $qp, %arg) = @_;
 | 
						|
  $self->register_hook("data_post", "tnef2mime");
 | 
						|
}
 | 
						|
 | 
						|
sub hasMessageClassProperty {
 | 
						|
  my $self = shift;
 | 
						|
  my $data = $self->data("Attachment");
 | 
						|
  return 0 unless $data;
 | 
						|
  return index( $data, pack( "H*", "8008" ) ) >= 0;
 | 
						|
}
 | 
						|
 | 
						|
# for future use
 | 
						|
sub kill_part ($)
 | 
						|
	{
 | 
						|
	my $part=$_;
 | 
						|
	#my $path = defined $part->bodyhandle ? $part->bodyhandle->path : "";
 | 
						|
	#my $filename = $part->head->recommended_filename || "";
 | 
						|
	return $part;
 | 
						|
	}
 | 
						|
 | 
						|
sub keep_part ($$)
 | 
						|
	{
 | 
						|
	my ($self,$part)=@_;
 | 
						|
	my $mm = new File::MMagic;
 | 
						|
 | 
						|
	# when a ms-tnef attachment was sent uuencoded, its MIME type becomes application/octet-stream
 | 
						|
	# after the conversion. Therefore all application/octet-stream attachments are assumed to
 | 
						|
	# be a ms-tnef
 | 
						|
 | 
						|
	my $path = $part->bodyhandle ? $part->bodyhandle->path : "";
 | 
						|
 | 
						|
	if( $part->mime_type =~ /ms-tnef/i || $part->mime_type =~ /application\/octet-stream/i )
 | 
						|
		{
 | 
						|
		# convert tnef attachments and write to files
 | 
						|
		my $tnef = Convert::TNEF->read_ent($part,{output_dir=>$tmpdir,output_to_core=>"NONE"});
 | 
						|
 | 
						|
		# if $tnef is undefined here, the application/octet-stream was not a ms-tnef and we are done.
 | 
						|
		return 1 if( ! defined $tnef );
 | 
						|
 | 
						|
		my $keep_tnef=0;
 | 
						|
		for ($tnef->attachments)
 | 
						|
			{
 | 
						|
			next if !defined $_->datahandle;
 | 
						|
 | 
						|
			if( hasMessageClassProperty($_) ) # Outlook MAPI object
 | 
						|
				{
 | 
						|
				$keep_tnef++;
 | 
						|
				$self->log(LOGWARN, sprintf "Outlook MAPI object #%i: %s", $keep_tnef, $_->longname);
 | 
						|
				next;
 | 
						|
				}
 | 
						|
 | 
						|
			my $mimetype = $mm->checktype_filename( $_->datahandle->path );
 | 
						|
			$attachments[$count] = MIME::Entity->build( 
 | 
						|
				Path=>$_->datahandle->path, 
 | 
						|
				Filename=>$_->longname, 
 | 
						|
				Encoding=>"base64", 
 | 
						|
				Type=>$mimetype );
 | 
						|
			$self->log(LOGWARN, 
 | 
						|
				sprintf "File attachment #%i: %s (%s, %ld bytes)", $count+1, $_->longname, $mimetype, $_->size );
 | 
						|
			$count++;
 | 
						|
			}
 | 
						|
 | 
						|
		if( $keep_tnef )
 | 
						|
			{
 | 
						|
			$attachments[$count++] = $part;
 | 
						|
			$self->log(LOGWARN, "Original TNEF file attached." );
 | 
						|
			}
 | 
						|
 | 
						|
		push( @tnefs, $tnef ); # remind for cleanup
 | 
						|
		$foundtnef=1;
 | 
						|
		return 0;
 | 
						|
		}
 | 
						|
	return 1;
 | 
						|
	}
 | 
						|
 | 
						|
 | 
						|
sub tnef2mime ( $$ )
 | 
						|
	{
 | 
						|
  	my ($self, $transaction) = @_;
 | 
						|
	# new Parser Object
 | 
						|
	$parser = new MIME::Parser;
 | 
						|
	# if you want to debug the Parser :
 | 
						|
	#use MIME::Tools; MIME::Tools->debugging(1);
 | 
						|
	# temp output directory
 | 
						|
	$parser->output_under( $tmpdir );
 | 
						|
	$parser->extract_uuencode(1);
 | 
						|
 | 
						|
	#untainted filename
 | 
						|
	$transaction->body_filename() =~ /^([:\-\/\w]+)\z/ or die "Disallowed characters in filename ".$transaction->body_filename();
 | 
						|
	my $bdfilename = $1;
 | 
						|
	# read message body
 | 
						|
	open BFN, "<", $bdfilename ;#$transaction->body_filename();
 | 
						|
	$ent = $parser->parse(\*BFN);
 | 
						|
	my @keep = grep { keep_part($self, $_) } $ent->parts; # @keep now holds all non-tnef attachments
 | 
						|
	close BFN;
 | 
						|
 | 
						|
	my $founduu = $ent->parts && !$transaction->header->get('MIME-Version');
 | 
						|
 | 
						|
	if( $foundtnef || $founduu )
 | 
						|
		{
 | 
						|
		my @allatt;
 | 
						|
		@allatt = map { kill_part($_) } ( @keep, @attachments );
 | 
						|
		$ent->parts(\@allatt);
 | 
						|
		# if message is a multipart type, but has MIME version tag, then add
 | 
						|
		# MIME version. PHP imap_fetchstructure() depends on that!
 | 
						|
		my $xac;
 | 
						|
		if( $founduu )
 | 
						|
			{
 | 
						|
			$transaction->header->add('MIME-Version', "1.0" );
 | 
						|
			$xac = "UUENCODE -> MIME";
 | 
						|
			$self->log(LOGDEBUG, "uuencoded attachment converted to MIME" );
 | 
						|
			}
 | 
						|
		# delete the X-MS-TNEF-Correlator header line
 | 
						|
		if( $foundtnef )
 | 
						|
			{
 | 
						|
			$xac .= ( defined $xac ? ", " : "" ) . "MS-TNEF -> MIME";
 | 
						|
			$transaction->header->delete('X-MS-TNEF-Correlator' );
 | 
						|
			}
 | 
						|
		# add own X header
 | 
						|
		if( defined $xac )
 | 
						|
			{
 | 
						|
			$transaction->header->add('X-TNEF2MIME-Plugin', $xac );
 | 
						|
			}
 | 
						|
		# write converted message body
 | 
						|
		open BFN, ">" , $bdfilename;#$transaction->body_filename();
 | 
						|
		$ent->print(\*BFN);
 | 
						|
		close BFN;
 | 
						|
		}
 | 
						|
 | 
						|
	# cleaning up
 | 
						|
	for( my $i=0; $i<@tnefs; $i++ )
 | 
						|
		{
 | 
						|
		$tnefs[$i]->purge();
 | 
						|
		}
 | 
						|
	
 | 
						|
        #untainted filename
 | 
						|
        $parser->output_dir =~ /^([:\-\/\w]+)\z/ or die "Disallowed characters in output dir ".$parser->output_dir;
 | 
						|
        my $output_dir = $1;
 | 
						|
	
 | 
						|
	opendir( DIR, $output_dir ) or die "Could not open temporary output dir $output_dir: $!\n";
 | 
						|
	while( defined( my $file = readdir( DIR ) ) )
 | 
						|
		{
 | 
						|
		next if $file =~ /^\.\.?$/;
 | 
						|
		$file =~ s/(^.*$)//;
 | 
						|
		$file = $1;
 | 
						|
		unlink( "$output_dir/$file" );
 | 
						|
		}
 | 
						|
	closedir( DIR );
 | 
						|
	rmdir( $output_dir );
 | 
						|
 | 
						|
  	return DECLINED; 
 | 
						|
	}
 |