All patches and comments are welcome. Please squash your changes to logical
commits before using git-format-patch and git-send-email to
patches@git.madduck.net.
If you'd read over the Git project's submission guidelines and adhered to them,
I'd be especially grateful.
13 my $mimetypes = MIME::Types->new;
16 while (defined(my $line = <STDIN>)) {
18 if ($line =~ /^(From\s+.+)\r?\n/ and length($message) or eof) {
19 parse_message(\$message, $msg_bound); # All the action happens here...
22 } elsif ($line =~ /^(From\s+.+)\r?\n/) {
23 $msg_bound=$line; # The first
30 # Subroutines ###############################################################
33 my $msg_body = shift @_;
34 my $msg_bound = shift @_;
35 my $mime_parser = new MIME::Parser;
37 # This module likes to use tmp files, but I try to stop it here.
38 $mime_parser->use_inner_files(1);
39 $mime_parser->output_to_core(1);
40 my $ent = $mime_parser->parse_data($$msg_body);
41 my $num_parts=$ent->parts;
43 # Determine if we have a MIME w/ms-tnef and act accordingly.
44 if ( ($num_parts < 1) || ($$msg_body !~ /ms-tnef/i) ) {
48 my $head = $ent->head;
49 my $ReturnPath = $head->get('Return-Path');
50 my @all_received = $head->get('Received');
51 my $Date = $head->get('Date');
52 my $From = $head->get('From');
53 my $XSender = $head->get('X-Sender');
54 my $To = $head->get('To');
55 my $Subject = $head->get('Subject');
56 my $MessageID = $head->get('Message-ID');
57 my $boundary = $head->multipart_boundary;
59 # Build a new MIME message based on the one we are examining
60 # - LHH: it would probably be better to build this $new_ent
61 # using $ent->head as the basis, thus getting *all* of
62 # the headers, instead of just these few. We only needed
63 # these few headers for the project this script was
64 # originally written for, but if someone wants to change
65 # this and submit a patch, that would be great.
66 my $new_ent = MIME::Entity->build(
67 'Type' => "multipart/mixed",
68 'Boundary' => $boundary,
71 my $new_head=$new_ent->head;
72 # Try to preserve the order of headers in the original message by
73 # extracting it from the original formatted header.
75 foreach my $tag (@{$head->header}, $head->tags) {
77 next if ($did_tag{lc $tag}++);
78 next if ($new_head->count($tag));
79 foreach my $value ($head->get_all($tag)) {
80 $new_head->add($tag, $value);
84 # Loop over each MIME part adding each to the new message
85 foreach my $mime_part_i (0 .. ($num_parts - 1)) {
86 my $ent_part=$ent->parts($mime_part_i);
87 if ($ent_part->mime_type =~ /ms-tnef/i ) {
88 add_tnef_parts($ent_part, $new_ent);
90 $new_ent->add_part($ent_part);
94 # Set the preamble and epilogue equal to the original
95 $new_ent->preamble($ent->preamble);
96 $new_ent->epilogue($ent->epilogue);
98 # Print the newly constructed MIME message
100 print STDOUT $new_ent->stringify;
108 ## Create a tnef object
109 my %TnefOpts=('output_to_core' => '4194304', 'output_dir' => '/tmp');
110 my $tnef = Convert::TNEF->read_ent($ent, \%TnefOpts);
111 my $head=$new->head; # Get the header object from the new message
113 warn "TNEF CONVERT DID NOT WORK: " . $Convert::TNEF::errstr . "\n";
114 warn " - Failed on msg w/subj: " . $head->get('Subject') . "\n";
118 #############################################################################
119 # This section of code smokes lots of crack, and tries to dig the From:
120 # header out of the $tnef->message if the new message we are appending
121 # this attachment to does not already have a "From" header. This is
122 # required on most of the Outlook emails that never touch SMTP, only
123 # Exchange servers, and never had valid SMTP From headers placed!
124 #############################################################################
125 my $msg=$tnef->message;
126 my $mapi_props=$msg->data('MAPIProps');
127 #warn join(", ", keys %{$msg->{MAPIProps}}) . "\n";
128 #warn $msg->{MAPIProps}->{MBS_Data} . "\n\n----------------------------\n\n";
129 #warn "$mapi_props\n\n---------------------------------\n\n";
131 #if ($mapi_props =~ m/(\0\0\0\xf8.{20})/) { warn "MATCHED a prop $1\n"; }
133 if (! length($head->get('From')) ) {
135 my $cntrl_chars='[\c' . join('\c', ('A' .. 'Z')) . ']';
136 if ($mapi_props =~ m/From:\s+([^\s\@]+\@[^\s]+)/) {
138 } elsif ($mapi_props =~ m/\xf8\?\cA\0\0\0$cntrl_chars\0\0\0([^\0]+)\0+\cB\cA/) {
141 if ($mapi_props =~ m/(\xf8\?\cA.{30})/) { warn "MATCH: $1\n"; }
142 #$from="Unknown Sender";
144 if( length($from)) { $head->replace('from', $from); }
146 #############################################################################
148 for ($tnef->attachments) {
149 $_->longname=~/^[\w\W]+\.(\w+)$/;
151 my $type = $mimetypes->mimeTypeOf($ext);
153 warn "No MIME type for (" . $_->longname . "/" . $_->name . ")\n";
154 $type = "Application/OCTET-STREAM";
158 if ($type =~ m,^text/,) {
159 if ($_->data =~ /[^\001-\177]/) {
167 $encoding = 'base64';
170 elsif ($_->data =~ /[^\t\n\r\f\040-\177]/) {
171 $encoding = 'base64';
179 Encoding => $encoding,
181 Disposition => 'attachment',
182 Filename => $_->longname
185 # If you want to delete the working files
194 cat mbox_msg_w_tnef | killtnef > mbox_msg_mime_compliant
198 killtnef - Converts emails with MS-TNEF, Microsoft's proprietary
199 Transport Neutral Encapsulated Format, attachments into standard
200 MIME-compliant emails.
202 This script reads an mbox, or a single email message, from STDIN,
203 extracts data from any ms-tnef attachments that may exist, and writes
204 a new mbox (or a single email message) to STDOUT which has each of the
205 files that were encoded in any ms-tnef attachments attached separately,
206 as RFC-822/RFC-1521 compliant MIME emails/attachments.
208 Any email(s) containing no ms-tnef MIME attachments are passed through
209 this script untouched.
213 This script was originally written to convert about 35,000 emails from
214 some Microsoft Outlook *.pst (post office) files, almost all of which
215 had ms-tnef encoded attachments, into MIME-compliant emails so that
216 they could be imported into an email-archiving system that 10East
217 supplies to some of its customers. If anyone is curious, an imapd
218 was used to move the emails from the *.pst files to mbox format using
219 Outlook 2000 as an IMAP client.
221 This script can also be used as an incoming mail filter which will
222 automatically convert ms-tnef attachments into MIME-compliant
227 Andrew Orr <aorr@10east.com> (no longer a maintainer)
229 Lester Hightower <hightowe@10east.com> (maintainer)
233 This software is licensed under the terms of the GNU Public License,
234 which is available for review at http://www.gnu.org/copyleft/gpl.html
238 Feb-22-2002: Originally created by Andy Orr
240 Feb-26-2002: A few enhancements and bug-fixes by Lester Hightower.
242 Mar-06-2002: Documentation and a few comments added by Lester Hightower
243 in preparation for submitting this script to CPAN.
245 Mar-07-2002: After realizing that a POD README section is needed for the
246 HTML pages generated for the script index in CPAN, LHH added one and
247 submitted this as killtnef-1.0.1.pl.
249 Sep-20-2005: Applied a patch provided by Jonathan Kamens and released that
250 as killtnef-1.0.2.pl. The patch did:
251 * Use /usr/bin/perl instead of /usr/local/bin/perl.
252 * Use MIME::Types instead of hard-coded list of
253 extensions and MIME types.
254 * Preserve MIME boundary and headers from original
256 * Try to use 7bit or 8bit encoding instead of base64
257 whenever possible. This makes resulting messages
258 smaller and easier to full-text index.
260 May-30-2007: Applied a patch provided by Stefan Bertels and released that
261 as killtnef-1.0.3.pl. The patch uses any "\w" characters after the last
262 dot in each attachments' longname as the file extenstion, instead of just
263 "([A-Za-z]{2,4})" and also defaults the type to "Application/OCTET-STREAM"
264 if no mimetype can be found for the file extenstion.
268 This script requires the C<strict>, C<Convert::TNEF 0.16>,
269 C<MIME::Parser 5.406>, and C<MIME::Types 1.15> modules.
279 =pod SCRIPT CATEGORIES