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

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

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

my $VERSION = 1.0;

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');

    # 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",
				'Return-Path' =&gt; $ReturnPath,
				'Date'        =&gt; $Date,
				'From'        =&gt; $From,
				'X-Sender'    =&gt; $XSender,
				'To'          =&gt; $To,
				'Subject'     =&gt; $Subject,
				'Message-ID'  =&gt; $MessageID
                                  );
    my $new_head=$new_ent-&gt;head;
    foreach my $received (@all_received) {
      $new_head-&gt;add('Received', $received);
    }

    # 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;

  # LHH: This should probably be loaded from /etc/mime.types, or something.
  #      A command line argument to this script pointing it at a mime.types
  #      file is probably appropriate.
  my %content_type = (
                       txt  =&gt; "text/plain",
                       html =&gt; "text/html",
                       doc  =&gt; "application/msword",
                       xls  =&gt; "application/vnd.ms-excel",
                       ppt  =&gt; "application/vnd.ms-powerpoint",
                       pdf  =&gt; "application/pdf",
                       rtf  =&gt; "application/rtf",
                       zip  =&gt; "application/zip",
                       ps   =&gt; "application/ps",
                       wpd  =&gt; "application/wordperfect5.1",
                       wks  =&gt; "application/vnd.ms-works",
                       jpg  =&gt; "image/jpeg",
                       gif  =&gt; "image/gif",
                       tif  =&gt; "image/tif",
                       png  =&gt; "image/png"
                     );

  ## 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;
    if (!$content_type{lc($ext)}) {
      warn "No MIME type for (" . $_-&gt;longname . "/" . $_-&gt;name . ")\n";
    } 
    $new-&gt;attach( 
                   Type =&gt; $content_type{lc($ext)},
                   Encoding =&gt; 'base64',
                   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;

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

=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.

=head1 PREREQUISITES

This script requires the C&lt;strict&gt; module.
It also requires C&lt;Convert::TNEF 0.16&gt; and C&lt;MIME::Parser 5.406&gt;

=head1 COREQUISITES

None.

=pod OSNAMES

Any Unix-like.

=pod SCRIPT CATEGORIES

Mail
Mail/Converters
Mail/Filters

=cut

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