<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl

############
# killtnef #
############

use strict;
use Convert::TNEF;
use MIME::Parser;
use MIME::Types;

my $VERSION = 1.0;
my $mimetypes = MIME::Types-&gt;new;

my $message;
while (defined(my $line = &lt;STDIN&gt;)) {
  my $msg_bound;
  if ($line =~ /^(From\s+.+)\r?\n/ and length($message) or eof) {
    parse_message(\$message, $msg_bound); # All the action happens here...
    $message = "";
    $msg_bound=$line;
  } elsif ($line =~ /^(From\s+.+)\r?\n/) {
    $msg_bound=$line;  # The first 
  } 
  $message.=$line;
}
exit;


# Subroutines ###############################################################

sub parse_message {
  my $msg_body = shift @_;
  my $msg_bound = shift @_;
  my $mime_parser = new MIME::Parser;

  # This module likes to use tmp files, but I try to stop it here.
  $mime_parser-&gt;use_inner_files(1);
  $mime_parser-&gt;output_to_core(1);
  my $ent = $mime_parser-&gt;parse_data($$msg_body);
  my $num_parts=$ent-&gt;parts;

  # Determine if we have a MIME w/ms-tnef and act accordingly.
  if ( ($num_parts &lt; 1) || ($$msg_body !~ /ms-tnef/i) ) {
    print "$$msg_body";
  } else {
    # Get the head info
    my $head = $ent-&gt;head;
    my $ReturnPath = $head-&gt;get('Return-Path');
    my @all_received = $head-&gt;get('Received');
    my $Date = $head-&gt;get('Date');
    my $From = $head-&gt;get('From');
    my $XSender = $head-&gt;get('X-Sender');
    my $To = $head-&gt;get('To');
    my $Subject = $head-&gt;get('Subject');
    my $MessageID = $head-&gt;get('Message-ID');
    my $boundary = $head-&gt;multipart_boundary;

    # Build a new MIME message based on the one we are examining
    # - LHH: it would probably be better to build this $new_ent
    #        using $ent-&gt;head as the basis, thus getting *all* of
    #        the headers, instead of just these few.  We only needed
    #        these few headers for the project this script was
    #        originally written for, but if someone wants to change
    #        this and submit a patch, that would be great.
    my $new_ent = MIME::Entity-&gt;build(
				'Type'        =&gt; "multipart/mixed",
				'Boundary'    =&gt; $boundary,
				'X-Mailer'    =&gt; undef
				      );
    my $new_head=$new_ent-&gt;head;
    # Try to preserve the order of headers in the original message by
    # extracting it from the original formatted header.
    my(%did_tag);
    foreach my $tag (@{$head-&gt;header}, $head-&gt;tags) {
	$tag =~ s/:.*//s;
	next if ($did_tag{lc $tag}++);
	next if ($new_head-&gt;count($tag));
	foreach my $value ($head-&gt;get_all($tag)) {
	    $new_head-&gt;add($tag, $value);
	}
    }

    # Loop over each MIME part adding each to the new message
    foreach my $mime_part_i (0 .. ($num_parts - 1)) {
      my $ent_part=$ent-&gt;parts($mime_part_i);
      if ($ent_part-&gt;mime_type =~ /ms-tnef/i )  {
        add_tnef_parts($ent_part, $new_ent);
      } else {
        $new_ent-&gt;add_part($ent_part);
      } 
    }

    # Set the preamble and epilogue equal to the original
    $new_ent-&gt;preamble($ent-&gt;preamble);
    $new_ent-&gt;epilogue($ent-&gt;epilogue);

    # Print the newly constructed MIME message
    print "$msg_bound"; 
    print STDOUT $new_ent-&gt;stringify;
  }
}

sub add_tnef_parts {
  my $ent = shift;
  my $new = shift;

  ## Create a tnef object
  my %TnefOpts=('output_to_core' =&gt; '4194304', 'output_dir' =&gt; '/tmp');
  my $tnef = Convert::TNEF-&gt;read_ent($ent, \%TnefOpts);
  my $head=$new-&gt;head;	# Get the header object from the new message
  if (! $tnef) {
    warn "TNEF CONVERT DID NOT WORK: " . $Convert::TNEF::errstr . "\n";
    warn "  - Failed on msg w/subj: " . $head-&gt;get('Subject') . "\n";
    return '';
  }

  #############################################################################
  # This section of code smokes lots of crack, and tries to dig the From:
  # header out of the $tnef-&gt;message if the new message we are appending
  # this attachment to does not already have a "From" header.  This is
  # required on most of the Outlook emails that never touch SMTP, only
  # Exchange servers, and never had valid SMTP From headers placed!
  #############################################################################
  my $msg=$tnef-&gt;message;
  my $mapi_props=$msg-&gt;data('MAPIProps');
  #warn join(", ", keys %{$msg-&gt;{MAPIProps}}) . "\n";
  #warn $msg-&gt;{MAPIProps}-&gt;{MBS_Data} . "\n\n----------------------------\n\n";
  #warn "$mapi_props\n\n---------------------------------\n\n";
  my $test=0x0024;
  #if ($mapi_props =~ m/(\0\0\0\xf8.{20})/) { warn "MATCHED a prop $1\n"; }
  #if (0) {
  if (! length($head-&gt;get('From')) ) {
    my $from='';
    my $cntrl_chars='[\c' . join('\c', ('A' .. 'Z')) . ']';
    if ($mapi_props =~ m/From:\s+([^\s\@]+\@[^\s]+)/) {
      $from=$1;
    } elsif ($mapi_props =~ m/\xf8\?\cA\0\0\0$cntrl_chars\0\0\0([^\0]+)\0+\cB\cA/) {
      $from=$1;
    } else {
      if ($mapi_props =~ m/(\xf8\?\cA.{30})/) { warn "MATCH: $1\n"; }
      #$from="Unknown Sender";
    }
    if( length($from)) { $head-&gt;replace('from', $from); }
  }
  #############################################################################

  for ($tnef-&gt;attachments) {
    $_-&gt;longname=~/^[\w\W]+\.([A-Za-z]{2,4})$/;
    my $ext = $1;
    my $type = $mimetypes-&gt;mimeTypeOf($ext);
    if (! $type) {
      warn "No MIME type for (" . $_-&gt;longname . "/" . $_-&gt;name . ")\n";
    }
    my $encoding;
    if ($type) {
	if ($type =~ m,^text/,) {
	    if ($_-&gt;data =~ /[^\001-\177]/) {
		$encoding = '8bit';
	    }
	    else {
		$encoding = '7bit';
	    }
	}
	else {
	    $encoding = 'base64';
	}
    }
    elsif ($_-&gt;data =~ /[^\t\n\r\f\040-\177]/) {
	$encoding = 'base64';
    }
    else {
	$encoding = '7bit';
    }

    $new-&gt;attach( 
                   Type =&gt; $type,
                   Encoding =&gt; $encoding,
                   Data =&gt; $_-&gt;data, 
                   Disposition =&gt; 'attachment',
                   Filename =&gt; $_-&gt;longname
                 );
  }
  # If you want to delete the working files
  $tnef-&gt;purge;
}


# POD documentation

=head1 SYNOPSIS


cat mbox_msg_w_tnef | killtnef &gt; mbox_msg_mime_compliant

=head1 README

killtnef - Converts emails with MS-TNEF, Microsoft's proprietary Transport Neutral Encapsulated Format, attachments into standard MIME-compliant emails.

This script reads an mbox, or a single email message, from STDIN,
extracts data from any ms-tnef attachments that may exist, and writes
a new mbox (or a single email message) to STDOUT which has each of the
files that were encoded in any ms-tnef attachments attached separately,
as RFC-822/RFC-1521 compliant MIME emails/attachments.

Any email(s) containing no ms-tnef MIME attachments are passed through
this script untouched.

=head1 DESCRIPTION

This script was originally written to convert about 35,000 emails from
some Microsoft Outlook *.pst (post office) files, almost all of which
had ms-tnef encoded attachments, into MIME-compliant emails so that
they could be imported into an email-archiving system that 10East
supplies to some of its customers.  If anyone is curious, an imapd
was used to move the emails from the *.pst files to mbox format using
Outlook 2000 as an IMAP client.

This script can also be used as an incoming mail filter which will
automatically convert ms-tnef attachments into MIME-compliant
attachments.

=head1 AUTHORSHIP

Andrew Orr &lt;aorr@10east.com&gt; (no longer a maintainer)

Lester Hightower &lt;hightowe@10east.com&gt; (maintainer)

=head1 LICENSE

This software is licensed under the terms of the GNU Public License,
which is available for review at http://www.gnu.org/copyleft/gpl.html

=head1 CHANGE LOG

Feb-22-2002: Originally created by Andy Orr

Feb-26-2002: A few enhancements and bug-fixes by Lester Hightower.

Mar-06-2002: Documentation and a few comments added by Lester Hightower
in preparation for submitting this script to CPAN.

Mar-07-2002: After realizing that a POD README section is needed for the
HTML pages generated for the script index in CPAN, LHH added one and
submitted this as killtnef-1.0.1.pl.

Sep-20-2005: Applied a patch provided by Jonathan Kamens and released that
as  killtnef-1.0.2.pl.  The patch did:
  * Use /usr/bin/perl instead of /usr/local/bin/perl.
  * Use MIME::Types instead of hard-coded list of
    extensions and MIME types.
  * Preserve MIME boundary and headers from original
    message.
  * Try to use 7bit or 8bit encoding instead of base64
    whenever possible.  This makes resulting messages
    smaller and easier to full-text index.

=head1 PREREQUISITES

This script requires the C&lt;strict&gt;, C&lt;Convert::TNEF 0.16&gt;,
C&lt;MIME::Parser 5.406&gt;, and C&lt;MIME::Types 1.15&gt; modules.

=head1 COREQUISITES

None.

=pod OSNAMES

Any Unix-like.

=pod SCRIPT CATEGORIES

Mail
Mail/Converters
Mail/Filters

=cut

</pre></body></html>