]> git.madduck.net Git - etc/mailfilter.git/blob - bin/killtnef

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

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.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

improve vacation message handling
[etc/mailfilter.git] / bin / killtnef
1 #!/usr/bin/perl
2
3 ############
4 # killtnef #
5 ############
6
7 use strict;
8 use Convert::TNEF;
9 use MIME::Parser;
10 use MIME::Types;
11
12 my $VERSION = 1.0.3;
13 my $mimetypes = MIME::Types->new;
14
15 my $message;
16 while (defined(my $line = <STDIN>)) {
17   my $msg_bound;
18   if ($line =~ /^(From\s+.+)\r?\n/ and length($message) or eof) {
19     parse_message(\$message, $msg_bound); # All the action happens here...
20     $message = "";
21     $msg_bound=$line;
22   } elsif ($line =~ /^(From\s+.+)\r?\n/) {
23     $msg_bound=$line;  # The first 
24   } 
25   $message.=$line;
26 }
27 exit;
28
29
30 # Subroutines ###############################################################
31
32 sub parse_message {
33   my $msg_body = shift @_;
34   my $msg_bound = shift @_;
35   my $mime_parser = new MIME::Parser;
36
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;
42
43   # Determine if we have a MIME w/ms-tnef and act accordingly.
44   if ( ($num_parts < 1) || ($$msg_body !~ /ms-tnef/i) ) {
45     print "$$msg_body";
46   } else {
47     # Get the head info
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;
58
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,
69                                 'X-Mailer'    => undef
70                                       );
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.
74     my(%did_tag);
75     foreach my $tag (@{$head->header}, $head->tags) {
76         $tag =~ s/:.*//s;
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);
81         }
82     }
83
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);
89       } else {
90         $new_ent->add_part($ent_part);
91       } 
92     }
93
94     # Set the preamble and epilogue equal to the original
95     $new_ent->preamble($ent->preamble);
96     $new_ent->epilogue($ent->epilogue);
97
98     # Print the newly constructed MIME message
99     print "$msg_bound"; 
100     print STDOUT $new_ent->stringify;
101   }
102 }
103
104 sub add_tnef_parts {
105   my $ent = shift;
106   my $new = shift;
107
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
112   if (! $tnef) {
113     warn "TNEF CONVERT DID NOT WORK: " . $Convert::TNEF::errstr . "\n";
114     warn "  - Failed on msg w/subj: " . $head->get('Subject') . "\n";
115     return '';
116   }
117
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";
130   my $test=0x0024;
131   #if ($mapi_props =~ m/(\0\0\0\xf8.{20})/) { warn "MATCHED a prop $1\n"; }
132   #if (0) {
133   if (! length($head->get('From')) ) {
134     my $from='';
135     my $cntrl_chars='[\c' . join('\c', ('A' .. 'Z')) . ']';
136     if ($mapi_props =~ m/From:\s+([^\s\@]+\@[^\s]+)/) {
137       $from=$1;
138     } elsif ($mapi_props =~ m/\xf8\?\cA\0\0\0$cntrl_chars\0\0\0([^\0]+)\0+\cB\cA/) {
139       $from=$1;
140     } else {
141       if ($mapi_props =~ m/(\xf8\?\cA.{30})/) { warn "MATCH: $1\n"; }
142       #$from="Unknown Sender";
143     }
144     if( length($from)) { $head->replace('from', $from); }
145   }
146   #############################################################################
147
148   for ($tnef->attachments) {
149     $_->longname=~/^[\w\W]+\.(\w+)$/;
150     my $ext = $1;
151     my $type = $mimetypes->mimeTypeOf($ext);
152     if (! $type) {
153       warn "No MIME type for (" . $_->longname . "/" . $_->name . ")\n";
154       $type = "Application/OCTET-STREAM";
155     }
156     my $encoding;
157     if ($type) {
158         if ($type =~ m,^text/,) {
159             if ($_->data =~ /[^\001-\177]/) {
160                 $encoding = '8bit';
161             }
162             else {
163                 $encoding = '7bit';
164             }
165         }
166         else {
167             $encoding = 'base64';
168         }
169     }
170     elsif ($_->data =~ /[^\t\n\r\f\040-\177]/) {
171         $encoding = 'base64';
172     }
173     else {
174         $encoding = '7bit';
175     }
176
177     $new->attach( 
178                    Type => $type,
179                    Encoding => $encoding,
180                    Data => $_->data, 
181                    Disposition => 'attachment',
182                    Filename => $_->longname
183                  );
184   }
185   # If you want to delete the working files
186   $tnef->purge;
187 }
188
189
190 # POD documentation
191
192 =head1 SYNOPSIS
193
194 cat mbox_msg_w_tnef | killtnef > mbox_msg_mime_compliant
195
196 =head1 README
197
198 killtnef - Converts emails with MS-TNEF, Microsoft's proprietary
199 Transport Neutral Encapsulated Format, attachments into standard
200 MIME-compliant emails.
201
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.
207
208 Any email(s) containing no ms-tnef MIME attachments are passed through
209 this script untouched.
210
211 =head1 DESCRIPTION
212
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.
220
221 This script can also be used as an incoming mail filter which will
222 automatically convert ms-tnef attachments into MIME-compliant
223 attachments.
224
225 =head1 AUTHORSHIP
226
227 Andrew Orr <aorr@10east.com> (no longer a maintainer)
228
229 Lester Hightower <hightowe@10east.com> (maintainer)
230
231 =head1 LICENSE
232
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
235
236 =head1 CHANGE LOG
237
238 Feb-22-2002: Originally created by Andy Orr
239
240 Feb-26-2002: A few enhancements and bug-fixes by Lester Hightower.
241
242 Mar-06-2002: Documentation and a few comments added by Lester Hightower
243 in preparation for submitting this script to CPAN.
244
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.
248
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
255     message.
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.
259
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.
265
266 =head1 PREREQUISITES
267
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.
270
271 =head1 COREQUISITES
272
273 None.
274
275 =pod OSNAMES
276
277 Any Unix-like.
278
279 =pod SCRIPT CATEGORIES
280
281 Mail
282 Mail/Converters
283 Mail/Filters
284
285 =cut
286