Convert-TNEF-0.18/000075000443420001604000000000001200331706200151655ustar00dwilsontechdept00005330011130Convert-TNEF-0.18/t/000075000443420001604000000000001200331706200154305ustar00dwilsontechdept00005330011130Convert-TNEF-0.18/t/tnef.doc000064400443420001604000000042460723137261000170750ustar00dwilsontechdept00005330011130x>"IPM.Microsoft Mail.Note1IPM.Microsoft Mail.Note1     !FBB2B56D7A9BD311BE0500A0C9235C6DIThis is a test d8?1@Zippy@0@Zippy@? *LZFuJp rcpg1252CtexA PV?U%Qch set2%3F0,3 ;05" `cP3 d36P Hi the d`g. ThZ Qat}pThis is a testq/5ZmzӾ#\mWNAISCANNEDzomod ???`ܧ@B+//O=BIIGGGGG COMPANY ENTERPRISES/OU=CORPORATE/CN=RECIPIENTS/CN=fredbuSMTPvfredb@COMPANYCO.net@ FRED JONSON4@fredbQGEX:/O=BIIGGGGG COMPANY ENTERPRISES/OU=CORPORATE/CN=RECIPIENTS/CN=fredb@C`ܧ@B+//O=BIIGGGGG COMPANY ENTERPRISES/OU=CORPORATE/CN=RECIPIENTS/CN=fredbwSMTPxfredb@COMPANYCO.netD FRED JONSON5@fredbRGEX:/O=BIIGGGGG COMPANY ENTERPRISES/OU=CORPORATE/CN=RECIPIENTS/CN=fredb@ W X YG?)+nTZippySMTPZippy?Zippy8@Zippy?`ܧ@B+//O=BIIGGGGG COMPANY ENTERPRISES/OU=CORPORATE/CN=RECIPIENTS/CN=fredb? FRED JONSON9@fredb@0*MZ5/@0V&6/=This is a test?5=96h@i@6 ) #lHITHEREFREDTHISISATEST=C =    tmp.out1This is an attachment is it all here? I hope so. d ! 7 q@0W5/@0W5/77tmp.out0tmp.out7application/octet-stream7mz#\m(Convert-TNEF-0.18/t/test.t000064400443420001604000000047440743622643000166260ustar00dwilsontechdept00005330011130# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..12\n"; } END {print "not ok 1\n" unless $loaded;} use Convert::TNEF; $loaded = 1; print "ok 1\n"; ######################### End of black magic. use strict; use Convert::TNEF; my $n = 2; my $tnef = Convert::TNEF->read_in("t/tnef.doc",{ignore_checksum=>1}); if (ref($tnef) eq 'Convert::TNEF') { print "ok $n\n"; } else { print "not ok $n\n"; exit; } my $att_cnt=0; my $att_name_exists; my $att_name_ok; my $att_lname_exists; my $att_lname_ok; my $att_data_exists; my $att_data_ok; for my $attachment ($tnef->attachments) { last if $att_cnt > 1; if (my $att_name = $attachment->name) { $att_name_exists++; if ($att_name eq "tmp.out") { $att_name_ok++; } } if (my $att_lname = $attachment->longname) { $att_lname_exists++; if ($att_lname eq "tmp.out") { $att_lname_ok++; } } if (my $att_data = $attachment->data) { $att_data_exists++; if ($att_data =~ /^This is an attachment/) { $att_data_ok++; } } $att_cnt++; } # Check here for errors from above $n++; if ($att_cnt == 1) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($att_name_exists) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($att_name_ok) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($att_lname_ok) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($att_data_exists) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($att_data_ok) { print "ok $n\n"; } else { print "not ok $n\n"; } # Test messages my $msg_exists; my $msg_class_exists; my $msg_class_ok; if (my $message = $tnef->message) { $msg_exists++; if (my $msg_class = $message->data('MessageClass')) { $msg_class_exists++; if ($msg_class eq "IPM.Microsoft Mail.Note\x00") { $msg_class_ok++; } } } $n++; if ($msg_exists) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($msg_class_exists) { print "ok $n\n"; } else { print "not ok $n\n"; } $n++; if ($msg_class_ok) { print "ok $n\n"; } else { print "not ok $n\n"; } # Check that errors work $n++; $tnef = Convert::TNEF->read_in("t/tnef.doc"); if ($Convert::TNEF::errstr eq 'Bad Checksum') { print "ok $n\n"; } else { print "not ok $n\n"; } Convert-TNEF-0.18/MANIFEST000064400443420001604000000002171200331654300163260ustar00dwilsontechdept00005330011130Changes MANIFEST README Makefile.PL TNEF.pm t/test.t t/tnef.doc META.yml Module meta-data (added by MakeMaker) Convert-TNEF-0.18/TNEF.pm000064400443420001604000000536361200331635500163050ustar00dwilsontechdept00005330011130# Convert::TNEF.pm # # Copyright (c) 1999 Douglas Wilson . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Convert::TNEF; use strict; use integer; use vars qw( $VERSION $TNEF_SIGNATURE $TNEF_PURE $LVL_MESSAGE $LVL_ATTACHMENT $errstr $g_file_cnt %dflts %atp %att %att_name ); use Carp; use IO::Wrap; use File::Spec; use MIME::Body; $VERSION = '0.18'; # Set some TNEF constants. Everything turned # out to be in little endian order, so I just added # 'reverse' everywhere that I needed to # instead of reversing the hex codes. $TNEF_SIGNATURE = reverse pack( 'H*', '223E9F78' ); $TNEF_PURE = reverse pack( 'H*', '00010000' ); $LVL_MESSAGE = pack( 'H*', '01' ); $LVL_ATTACHMENT = pack( 'H*', '02' ); %atp = ( Triples => pack( 'H*', '0000' ), String => pack( 'H*', '0001' ), Text => pack( 'H*', '0002' ), Date => pack( 'H*', '0003' ), Short => pack( 'H*', '0004' ), Long => pack( 'H*', '0005' ), Byte => pack( 'H*', '0006' ), Word => pack( 'H*', '0007' ), Dword => pack( 'H*', '0008' ), Max => pack( 'H*', '0009' ), ); for ( keys %atp ) { $atp{$_} = reverse $atp{$_}; } sub _ATT { my ( $att, $id ) = @_; return reverse($id) . $att; } # The side comments are 'MAPI' equivalents %att = ( Null => _ATT( pack( 'H*', '0000' ), pack( 'H4', '0000' ) ), # PR_ORIGINATOR_RETURN_ADDRESS From => _ATT( $atp{Triples}, pack( 'H*', '8000' ) ), # PR_SUBJECT Subject => _ATT( $atp{String}, pack( 'H*', '8004' ) ), # PR_CLIENT_SUBMIT_TIME DateSent => _ATT( $atp{Date}, pack( 'H*', '8005' ) ), # PR_MESSAGE_DELIVERY_TIME DateRecd => _ATT( $atp{Date}, pack( 'H*', '8006' ) ), # PR_MESSAGE_FLAGS MessageStatus => _ATT( $atp{Byte}, pack( 'H*', '8007' ) ), # PR_MESSAGE_CLASS MessageClass => _ATT( $atp{Word}, pack( 'H*', '8008' ) ), # PR_MESSAGE_ID MessageID => _ATT( $atp{String}, pack( 'H*', '8009' ) ), # PR_PARENT_ID ParentID => _ATT( $atp{String}, pack( 'H*', '800A' ) ), # PR_CONVERSATION_ID ConversationID => _ATT( $atp{String}, pack( 'H*', '800B' ) ), Body => _ATT( $atp{Text}, pack( 'H*', '800C' ) ), # PR_BODY # PR_IMPORTANCE Priority => _ATT( $atp{Short}, pack( 'H*', '800D' ) ), # PR_ATTACH_DATA_xxx AttachData => _ATT( $atp{Byte}, pack( 'H*', '800F' ) ), # PR_ATTACH_FILENAME AttachTitle => _ATT( $atp{String}, pack( 'H*', '8010' ) ), # PR_ATTACH_RENDERING AttachMetaFile => _ATT( $atp{Byte}, pack( 'H*', '8011' ) ), # PR_CREATION_TIME AttachCreateDate => _ATT( $atp{Date}, pack( 'H*', '8012' ) ), # PR_LAST_MODIFICATION_TIME AttachModifyDate => _ATT( $atp{Date}, pack( 'H*', '8013' ) ), # PR_LAST_MODIFICATION_TIME DateModified => _ATT( $atp{Date}, pack( 'H*', '8020' ) ), #PR_ATTACH_TRANSPORT_NAME AttachTransportFilename => _ATT( $atp{Byte}, pack( 'H*', '9001' ) ), AttachRenddata => _ATT( $atp{Byte}, pack( 'H*', '9002' ) ), MAPIProps => _ATT( $atp{Byte}, pack( 'H*', '9003' ) ), # PR_MESSAGE_RECIPIENTS RecipTable => _ATT( $atp{Byte}, pack( 'H*', '9004' ) ), Attachment => _ATT( $atp{Byte}, pack( 'H*', '9005' ) ), TnefVersion => _ATT( $atp{Dword}, pack( 'H*', '9006' ) ), OemCodepage => _ATT( $atp{Byte}, pack( 'H*', '9007' ) ), # PR_ORIG_MESSAGE_CLASS OriginalMessageClass => _ATT( $atp{Word}, pack( 'H*', '0006' ) ), # PR_RCVD_REPRESENTING_xxx or PR_SENT_REPRESENTING_xxx Owner => _ATT( $atp{Byte}, pack( 'H*', '0000' ) ), # PR_SENT_REPRESENTING_xxx SentFor => _ATT( $atp{Byte}, pack( 'H*', '0001' ) ), # PR_RCVD_REPRESENTING_xxx Delegate => _ATT( $atp{Byte}, pack( 'H*', '0002' ) ), # PR_DATE_START DateStart => _ATT( $atp{Date}, pack( 'H*', '0006' ) ), DateEnd => _ATT( $atp{Date}, pack( 'H*', '0007' ) ), # PR_DATE_END # PR_OWNER_APPT_ID AidOwner => _ATT( $atp{Long}, pack( 'H*', '0008' ) ), # PR_RESPONSE_REQUESTED RequestRes => _ATT( $atp{Short}, pack( 'H*', '0009' ) ), ); # Create reverse lookup table %att_name = reverse %att; # Global counter for creating file names $g_file_cnt = 0; # Set some package global defaults for new objects # which can be overridden for any individual object. %dflts = ( debug => 0, debug_max_display => 1024, debug_max_line_size => 64, ignore_checksum => 0, display_after_err => 32, output_to_core => 4096, output_dir => File::Spec->curdir, output_prefix => "tnef", buffer_size => 1024, ); # Make a file name sub _mk_fname { my $parms = shift; File::Spec->catfile( $parms->{output_dir}, $parms->{output_prefix} . "-" . $$ . "-" . ++$g_file_cnt . ".doc" ); } sub _rtn_err { my ( $errmsg, $fh, $parms ) = @_; $errstr = $errmsg; if ( $parms->{debug} ) { my $read_size = $parms->{display_after_err} || 32; my $data; $fh->read( $data, $read_size ); print "Error: $errstr\n"; print "Data:\n"; print $1, "\n" while $data =~ /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/g; print "HData:\n"; my $hdata = unpack( "H*", $data ); print $1, "\n" while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; } return undef; } sub _read_err { my ( $bytes, $fh, $errmsg ) = @_; $errstr = ( defined $bytes ) ? "Premature EOF" : "Read Error:" . $errmsg; return undef; } sub read_ent { croak "Usage: Convert::TNEF->read_ent(entity, parameters) " unless @_ == 2 or @_ == 3; my $self = shift; my ( $ent, $parms ) = @_; my $io = $ent->open("r") or do { $errstr = "Can't open entity: $!"; return undef; }; my $tnef = $self->read( $io, $parms ); $io->close or do { $errstr = "Error closing handle: $!"; return undef; }; return $tnef; } sub read_in { croak "Usage: Convert::TNEF->read_in(filename, parameters) " unless @_ == 2 or @_ == 3; my $self = shift; my ( $fname, $parms ) = @_; open( INFILE, "<$fname" ) or do { $errstr = "Can't open $fname: $!"; return undef; }; binmode INFILE; my $tnef = $self->read( \*INFILE, $parms ); close INFILE or do { $errstr = "Error closing $fname: $!"; return undef; }; return $tnef; } sub read { croak "Usage: Convert::TNEF->read(fh, parameters) " unless @_ == 2 or @_ == 3; my $self = shift; my $class = ref($self) || $self; $self = {}; bless $self, $class; my ( $fd, $parms ) = @_; $fd = wraphandle($fd); my %parms = %dflts; @parms{ keys %$parms } = values %$parms if defined $parms; $parms = \%parms; my $debug = $parms{debug}; my $ignore_checksum = $parms{ignore_checksum}; # Start of TNEF stream my $data; my $num_bytes = $fd->read( $data, 4 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; print "TNEF start: ", unpack( "H*", $data ), "\n" if $debug; return _rtn_err( "Not TNEF-encapsulated", $fd, $parms ) unless $data eq $TNEF_SIGNATURE; # Key $num_bytes = $fd->read( $data, 2 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 2; print "TNEF key: ", unpack( "H*", $data ), "\n" if $debug; # Start of First Object $num_bytes = $fd->read( $data, 1 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 1; my $msg_att = ""; my $is_msg = ( $data eq $LVL_MESSAGE ); my $is_att = ( $data eq $LVL_ATTACHMENT ); print "TNEF object start: ", unpack( "H*", $data ), "\n" if $debug; return _rtn_err( "Neither a message nor an attachment", $fd, $parms ) unless $is_msg or $is_att; my $msg = Convert::TNEF::Data->new; my @atts; # Current message or attachment in loop my $ent = $msg; # Read message and attachments LOOP: { my $type = $is_msg ? 'message' : 'attachment'; print "Reading $type attribute\n" if $debug; $num_bytes = $fd->read( $data, 4 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; my $att_id = $data; my $att_name = $att_name{$att_id}; print "TNEF $type attribute: ", unpack( "H*", $data ), "\n" if $debug; return _rtn_err( "Bad Attribute found in $type", $fd, $parms ) unless $att_name{$att_id}; if ( $att_id eq $att{TnefVersion} ) { return _rtn_err( "Version attribute found in attachment", $fd, $parms ) if $is_att; } elsif ( $att_id eq $att{MessageClass} ) { return _rtn_err( "MessageClass attribute found in attachment", $fd, $parms ) if $is_att; } elsif ( $att_id eq $att{AttachRenddata} ) { return _rtn_err( "AttachRenddata attribute found in message", $fd, $parms ) if $is_msg; push @atts, ( $ent = Convert::TNEF::Data->new ); } else { return _rtn_err( "AttachRenddata must be first attribute", $fd, $parms ) if $is_att and !@atts and $att_name ne "AttachRenddata"; } print "Got attribute:$att_name{$att_id}\n" if $debug; $num_bytes = $fd->read( $data, 4 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 4; print "HLength:", unpack( "H8", $data ), "\n" if $debug; my $length = unpack( "V", $data ); print "Length: $length\n" if $debug; # Get the attribute data (returns an object since data may # actually end up in a file) my $calc_chksum; $data = _build_data( $fd, $length, \$calc_chksum, $parms ) or return undef; _debug_print( $length, $att_id, $data, $parms ) if $debug; $ent->datahandle( $att_name, $data, $length ); $num_bytes = $fd->read( $data, 2 ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == 2; my $file_chksum = $data; if ($debug) { print "Calc Chksum:", unpack( "H*", $calc_chksum ), "\n"; print "File Chksum:", unpack( "H*", $file_chksum ), "\n"; } return _rtn_err( "Bad Checksum", $fd, $parms ) unless $calc_chksum eq $file_chksum or $ignore_checksum; my $num_bytes = $fd->read( $data, 1 ); # EOF (0 bytes) is ok return _read_err( $num_bytes, $fd, $! ) unless defined $num_bytes; last LOOP if $num_bytes < 1; print "Next token:", unpack( "H2", $data ), "\n" if $debug; $is_msg = ( $data eq $LVL_MESSAGE ); return _rtn_err( "Found message data in attachment", $fd, $parms ) if $is_msg and $is_att; $is_att = ( $data eq $LVL_ATTACHMENT ); redo LOOP if $is_msg or $is_att; return _rtn_err( "Not a TNEF $type", $fd, $parms ); } print "EOF\n" if $debug; $self->{TN_Message} = $msg; $self->{TN_Attachments} = \@atts; return $self; } sub _debug_print { my ( $length, $att_id, $data, $parms ) = @_; if ( $length < $parms->{debug_max_display} ) { $data = $data->data; if ( $att_id eq $att{TnefVersion} ) { $data = unpack( "L", $data ); print "Version: $data\n"; } elsif ( substr( $att_id, 2 ) eq $atp{Date} and $length == 14 ) { my ( $yr, $mo, $day, $hr, $min, $sec, $dow ) = unpack( "vvvvvvv", $data ); my $date = join ":", $yr, $mo, $day, $hr, $min, $sec, $dow; print "Date: $date\n"; print "HDate:", unpack( "H*", $data ), "\n"; } elsif ( $att_id eq $att{AttachRenddata} and $length == 14 ) { my ( $atyp, $ulPosition, $dxWidth, $dyHeight, $dwFlags ) = unpack( "vVvvV", $data ); $data = join ":", $atyp, $ulPosition, $dxWidth, $dyHeight, $dwFlags; print "AttachRendData: $data\n"; } else { print "Data:\n"; print $1, "\n" while $data =~ /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/g; print "HData:\n"; my $hdata = unpack( "H*", $data ); print $1, "\n" while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; } } else { my $io = $data->open("r") or croak "Error opening attachment data handle: $!"; my $buffer; $io->read( $buffer, $parms->{debug_max_display} ); $io->close or croak "Error closing attachment data handle: $!"; print "Data:\n"; print $1, "\n" while $buffer =~ /([^\r\n]{0,$parms->{debug_max_line_size}})\r?\n?/sg; print "HData:\n"; my $hdata = unpack( "H*", $buffer ); print $1, "\n" while $hdata =~ /(.{0,$parms->{debug_max_line_size}})/g; } } sub _build_data { my ( $fd, $length, $chksumref, $parms ) = @_; my $cutoff = $parms->{output_to_core}; my $incore = do { if ( $cutoff eq 'NONE' ) { 0 } #Everything to files elsif ( $cutoff eq 'ALL' ) { 1 } #Everything in memory elsif ( $cutoff < $length ) { 0 } #Large items in files else { 1 } #Everything else in memory }; # Just borrow some other objects for the attachment attribute data my $body = ($incore) ? new MIME::Body::Scalar : new MIME::Body::File _mk_fname($parms); $body->binmode(1); my $io = $body->open("w"); my $bufsiz = $parms->{buffer_size}; $bufsiz = $length if $length < $bufsiz; my $buffer; my $chksum = 0; while ( $length > 0 ) { my $num_bytes = $fd->read( $buffer, $bufsiz ); return _read_err( $num_bytes, $fd, $! ) unless $num_bytes == $bufsiz; $io->print($buffer); $chksum += unpack( "%16C*", $buffer ); $chksum %= 65536; $length -= $bufsiz; $bufsiz = $length if $length < $bufsiz; } $$chksumref = pack( "v", $chksum ); $io->close; return $body; } sub purge { my $self = shift; my $msg = $self->{TN_Message}; my @atts = $self->attachments; for ( keys %$msg ) { $msg->{$_}->purge if exists $att{$_}; } for my $attch (@atts) { for ( keys %$attch ) { $attch->{$_}->purge if exists $att{$_}; } } } sub message { my $self = shift; $self->{TN_Message}; } sub attachments { my $self = shift; return @{ $self->{TN_Attachments} } if wantarray; $self->{TN_Attachments}; } # This is for Messages or Attachments # since they are essentially the same thing except # for the leading attribute code package Convert::TNEF::Data; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; $self->{TN_Size} = {}; bless $self, $class; } sub data { my $self = shift; my $attr = shift || 'AttachData'; return $self->{$attr} && $self->{$attr}->as_string; } sub name { my $self = shift; my $attr = shift || 'AttachTitle'; my $name = $self->{$attr} && $self->{$attr}->data; $name =~ s/\x00+$// if $name; return $name; } # Try to get the long filename out of the # 'Attachment' attribute. sub longname { my $self = shift; my $data = $self->data("Attachment"); return unless $data; my $pos = index( $data, pack( "H*", "1e00013001" ) ); $pos = index( $data, pack( "H*", "1e00073701" ) ) if ($pos < 0); return $self->name unless $pos >= 0; my $len = unpack( "V", substr( $data, $pos + 8, 4 ) ); my $longname = substr( $data, $pos + 12, $len ); $longname =~ s/\x00+$// if $longname; return $longname || $self->name; } sub datahandle { my $self = shift; my $attr = shift || 'AttachData'; $self->{$attr} = shift if @_; $self->size( $attr, shift ) if @_; return $self->{$attr}; } sub size { my $self = shift; my $attr = shift || 'AttachData'; $self->{TN_Size}->{$attr} = shift if @_; return $self->{TN_Size}->{$attr}; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ =head1 NAME Convert::TNEF - Perl module to read TNEF files =head1 SYNOPSIS use Convert::TNEF; $tnef = Convert::TNEF->read($iohandle, \%parms) or die Convert::TNEF::errstr; $tnef = Convert::TNEF->read_in($filename, \%parms) or die Convert::TNEF::errstr; $tnef = Convert::TNEF->read_ent($mime_entity, \%parms) or die Convert::TNEF::errstr; $tnef->purge; $message = $tnef->message; @attachments = $tnef->attachments; $attribute_value = $attachments[$i]->data($att_attribute_name); $attribute_value_size = $attachments[$i]->size($att_attribute_name); $attachment_name = $attachments[$i]->name; $long_attachment_name = $attachments[$i]->longname; $datahandle = $attachments[$i]->datahandle($att_attribute_name); =head1 DESCRIPTION TNEF stands for Transport Neutral Encapsulation Format, and if you've ever been unfortunate enough to receive one of these files as an email attachment, you may want to use this module. read() takes as its first argument any file handle open for reading. The optional second argument is a hash reference which contains one or more of the following keys: =head2 output_dir - Path for storing TNEF attribute data kept in files (default: current directory). output_prefix - File prefix for TNEF attribute data kept in files (default: 'tnef'). output_to_core - TNEF attribute data will be saved in core memory unless it is greater than this many bytes (default: 4096). May also be set to 'NONE' to keep all data in files, or 'ALL' to keep all data in core. buffer_size - Buffer size for reading in the TNEF file (default: 1024). debug - If true, outputs all sorts of info about what the read() function is reading, including the raw ascii data along with the data converted to hex (default: false). display_after_err - If debug is true and an error is encountered, reads and displays this many bytes of data following the error (default: 32). debug_max_display - If debug is true then read and display at most this many bytes of data for each TNEF attribute (default: 1024). debug_max_line_size - If debug is true then at most this many bytes of data will be displayed on each line for each TNEF attribute (default: 64). ignore_checksum - If true, will ignore checksum errors while parsing data (default: false). read() returns an object containing the TNEF 'attributes' read from the file and the data for those attributes. If all you want are the attachments, then this is mostly garbage, but if you're interested then you can see all the garbage by turning on debugging. If the garbage proves useful to you, then let me know how I can maybe make it more useful. If an error is encountered, an undefined value is returned and the package variable $errstr is set to some helpful message. read_in() is a convienient front end for read() which takes a filename instead of a handle. read_ent() is another convient front end for read() which can take a MIME::Entity object (or any object with like methods, specifically open("r"), read($buff,$num_bytes), and close ). purge() deletes any on-disk data that may be in the attachments of the TNEF object. message() returns the message portion of the tnef object, if any. The thing it returns is like an attachment, but its not an attachment. For instance, it more than likely does not have a name or any attachment data. attachments() returns a list of the attachments that the given TNEF object contains. Returns a list ref if not called in array context. data() takes a TNEF attribute name, and returns a string value for that attribute for that attachment. Its your own problem if the string is too big for memory. If no argument is given, then the 'AttachData' attribute is assumed, which is probably the attachment data you're looking for. name() is the same as data(), except the attribute 'AttachTitle' is the default, which returns the 8 character + 3 character extension name of the attachment. longname() returns the long filename and extension of an attachment. This is embedded within a MAPI property of the 'Attachment' attribute data, so we attempt to extract the name out of that. size() takes an TNEF attribute name, and returns the size in bytes for the data for that attachment attribute. datahandle() is a method for attachments which takes a TNEF attribute name, and returns the data for that attribute as a handle which is the same as a MIME::Body handle. See MIME::Body for all the applicable methods. If no argument is given, then 'AttachData' is assumed. =head1 EXAMPLES # Here's a rather long example where mail is retrieved # from a POP3 server based on header information, then # it is MIME parsed, and then the TNEF contents # are extracted and converted. use strict; use Net::POP3; use MIME::Parser; use Convert::TNEF; my $mail_dir = "mailout"; my $mail_prefix = "mail"; my $pop = new Net::POP3 ( "pop3server_name" ); my $num_msgs = $pop->login("user_name","password"); die "Can't login: $!" unless defined $num_msgs; # Get mail by sender and subject my $mail_out_idx = 0; MESSAGE: for ( my $i=1; $i<= $num_msgs; $i++ ) { my $header = join "", @{$pop->top($i)}; for ($header) { next MESSAGE unless /^from:.*someone\@somewhere.net/im && /^subject:\s*important stuff/im } my $fname = $mail_prefix."-".$$.++$mail_out_idx.".doc"; open (MAILOUT, ">$mail_dir/$fname") or die "Can't open $mail_dir/$fname: $!"; # If the get() complains, you need the new libnet bundle $pop->get($i, \*MAILOUT) or die "Can't read mail"; close MAILOUT or die "Error closing $mail_dir/$fname"; # If you want to delete the mail on the server # $pop->delete($i); } close MAILOUT; $pop->quit(); # Parse the mail message into separate mime entities my $parser=new MIME::Parser; $parser->output_dir("mimemail"); opendir(DIR, $mail_dir) or die "Can't open directory $mail_dir: $!"; my @files = map { $mail_dir."/".$_ } sort grep { -f "$mail_dir/$_" and /$mail_prefix-$$-/o } readdir DIR; closedir DIR; for my $file ( @files ) { my $entity=$parser->parse_in($file) or die "Couldn't parse mail"; print_tnef_parts($entity); # If you want to delete the working files # $entity->purge; } sub print_tnef_parts { my $ent = shift; if ( $ent->parts ) { for my $sub_ent ( $ent->parts ) { print_tnef_parts($sub_ent); } } elsif ( $ent->mime_type =~ /ms-tnef/i ) { # Create a tnef object my $tnef = Convert::TNEF->read_ent($ent,{output_dir=>"tnefmail"}) or die $Convert::TNEF::errstr; for ($tnef->attachments) { print "Title:",$_->name,"\n"; print "Data:\n",$_->data,"\n"; } # If you want to delete the working files # $tnef->purge; } } =head1 SEE ALSO perl(1), IO::Wrap(3), MIME::Parser(3), MIME::Entity(3), MIME::Body(3) =head1 CAVEATS The parsing may depend on the endianness (see perlport) and width of integers on the system where the TNEF file was created. If this proves to be the case (check the debug output), I'll see what I can do about it. =head1 AUTHOR Douglas Wilson, dougw@cpan.org =cut ine_size}})/g; } } sub _build_data { my ( $fd, $length, $chksumref, $parms ) = @_; my $cutoConvert-TNEF-0.18/META.yml000066000443420001604000000007771200331706200164540ustar00dwilsontechdept00005330011130--- #YAML:1.0 name: Convert-TNEF version: 0.18 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: IO::Wrap: 0 MIME::Body: 4.109 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Convert-TNEF-0.18/Changes000064400443420001604000000137341200331617100164750ustar00dwilsontechdept00005330011130Revision history for Perl extension Convert::TNEF. 0.18 Mon Jul 23 2012 - Add IO::Wrap dependency to Makefile.PL (RT78412). - Change longname() to detect names in newer versions of Outlook. (RT78484) 0.17 Sun Feb 24 2001 - It appears that messages no longer need start with a TnefVersion attribute, and a message without this attribute triggered a bug ('datahandle' method called on uninitialized value) found by Randy Diffenderfer. - Although the MSDN TNEF Stream syntax page makes it look like TnefVersion must be the first attribute if it appears, and MessageClass must be the first or second attribute if it appears, I'm not going to check for this because then my test file has MessageClass as the third attribute. - Got rid of '_equal' function. The only reason to worry about warnings when comparing undef is if there's a read error, and then a warning ought to be ok anyway. - Long overdue perltidy format cleanup. 0.16 Tue Jul 31 2001 - Simplified main loop some more. Don't need to check for end of processing twice. - Prefixed 'private' functions with underscore character. - changed a couple of 'methods' which didn't use '$self' and weren't documented as methods into 'private' functions. 0.15 Tue Jul 31 2001 - Finally combined message and attachment parsing loops. - Removed the '|| []' from the attachment() method. I'm storing an arrayref unconditionally in the TNEF object, so there should be no need for this. Also now returns ref if not called in list context. 0.14 Mon Jul 30 2001 - Subclass message and attachment portions of TNEF object. - Found bug in saving the size of message attributes. 0.12 Tue May 29 2001 - We're not using Autoloader, so no need to 'use' it. 0.11 Tue May 29 2001 - Moved previously 'autoload' functions so that they're all just loaded. Its a small module anyway, so there was no real need for it, and it should cut down on problems for people who don't install this module properly :) 0.10 Wed Jan 17 2001 - Stripped carriage returns from all files (last edit was on Windows). 0.09 Wed Jan 10 2001 - Fixed message method. Added more tests to test suite. 0.08 Fri Jun 17 2000 - Added a bit more file format error checking. 0.07 Fri Jun 16 2000 - Just some code cleanup in reading the attachment part of the file. When there's more than one attachment in a file, it is now more efficient than it used to be. 0.06 Thu Jun 15 2000 - size() method is fixed. - data(), name() and longname() methods will now return the undefined value if the data does not exist in the attachment. - Not a change, just a realization that the TNEF 'attAttachment' attribute where the long filename and display name resides is really a series of MAPI properties. Maybe there ought to be a MAPI module to parse it? Currently, the longname() attribute is returning the MAPI display name property in this field. See previous changes for why. 0.05 Tue May 16 16:30:00 2000 - Both name() and longname() now strip trailing null characters. This doesn't seem to make a difference when creating a file, but it does in string comparison. - longname() works much better now. It no longer depends on finding the 'AttachTitle' attribute (shortname) first (which was a sorry hack of a way to do it). I've looked at several different TNEF example docs, from my own creation and from Mark Simpson's 'tnef' utility, so I'm fairly certain about it now. The actual file name appears twice in the field, but one of them is not always the full name (if there's a space in the name?). So we get the other instance of the name. If someone could look through the MS Platform SDK and see if the 'official' way to parse this field is in there, it'd be much appreciated. - Fixed the 'make test', which really wasn't testing what it was supposed to, and added another test while I was at it. 0.04 Thu May 11 16:00:00 2000 - The longname method should work better now. I still wish I could be 100% sure about the way I'm doing it. I'm sure its not the way Outlook does it; it'd be nice to know how its supposed to be done. 0.03 Tue May 8 15:00:00 2000 - There was two purge methods. I purged one of them. - fixed a die() in the parse method to return a failure status instead. - Took out the subclasses which were just aliases for MIME::Body::*, and weren't really proper subclasses anyway. I forget why I did it that way, maybe I planned on making some extra methods later, or just to see if it worked. There really should be separate classes for a TNEF object, and for attachments/messages in the TNEF object, maybe someday I'll get around to it. 0.02 Mon Dec 12 17:30:00 1999 - fixed and cleaned up some of the debug output. - had the bright idea in the first release of including a name() method for attachments and put it in the documentation, but neglected to actually include the method in the code. - Found out that the 'AttachTitle' attribute returns only the short (8 char + 3 char extension) version of the filename, so I included a 'longname' method which does its best to get the long version of the filename. This is extracted out of the 'Attachment' attribute data, which is a binary field, and I don't really know how to parse this field, but this seems to work to get the name. 0.01 Mon Nov 29 14:26:32 1999 - original version; created by h2xs 1.18 Convert-TNEF-0.18/Makefile.PL000064400443420001604000000004661200331570100171500ustar00dwilsontechdept00005330011130use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Convert::TNEF', 'VERSION_FROM' => 'TNEF.pm', # finds $VERSION 'PREREQ_PM' => { 'MIME::Body' => 4.109, 'IO::Wrap' => 0 }, ); Convert-TNEF-0.18/README000064400443420001604000000124350733140363000160640ustar00dwilsontechdept00005330011130 NAME Convert::TNEF - Perl module to read TNEF files INSTALL The usual: perl Makefile.PL make make test make install SYNOPSIS use Convert::TNEF; $tnef = Convert::TNEF->read($iohandle, \%parms) or die Convert::TNEF::errstr; $tnef = Convert::TNEF->read_in($filename, \%parms) or die Convert::TNEF::errstr; $tnef = Convert::TNEF->read_ent($mime_entity, \%parms) or die Convert::TNEF::errstr; $tnef->purge; $message = $tnef->message; @attachments = $tnef->attachments; $attribute_value = $attachments[$i]->data($att_attribute_name); $attribute_value_size = $attachments[$i]->size($att_attribute_name); $attachment_name = $attachments[$i]->name; $long_attachment_name = $attachments[$i]->longname; $datahandle = $attachments[$i]->datahandle($att_attribute_name); DESCRIPTION TNEF stands for Transport Neutral Encapsulation Format, and if you've ever been unfortunate enough to receive one of these files as an email attachment, you may want to use this module. read() takes as its first argument any file handle open for reading. The optional second argument is a hash reference which contains one or more of the following keys: output_dir - Path for storing TNEF attribute data kept in files (default: current directory). output_prefix - File prefix for TNEF attribute data kept in files (default: 'tnef'). output_to_core - TNEF attribute data will be saved in core memory unless it is greater than this many bytes (default: 4096). May also be set to 'NONE' to keep all data in files, or 'ALL' to keep all data in core. buffer_size - Buffer size for reading in the TNEF file (default: 1024). debug - If true, outputs all sorts of info about what the read() function is reading, including the raw ascii data along with the data converted to hex (default: false). display_after_err - If debug is true and an error is encountered, reads and displays this many bytes of data following the error (default: 32). debug_max_display - If debug is true then read and display at most this many bytes of data for each TNEF attribute (default: 1024). debug_max_line_size - If debug is true then at most this many bytes of data will be displayed on each line for each TNEF attribute (default: 64). ignore_checksum - If true, will ignore checksum errors while parsing data (default: false). read() returns an object containing the TNEF 'attributes' read from the file and the data for those attributes. If all you want are the attachments, then this is mostly garbage, but if you're interested then you can see all the garbage by turning on debugging. If the garbage proves useful to you, then let me know how I can maybe make it more useful. If an error is encountered, an undefined value is returned and the package variable $errstr is set to some helpful message. read_in() is a convienient front end for read() which takes a filename instead of a handle. read_ent() is another convient front end for read() which can take a MIME::Entity object (or any object with like methods, specifically open("r"), read($buff,$num_bytes), and close ). purge() deletes any on-disk data that may be in the attachments of the TNEF object. message() returns the message portion of the tnef object, if any. The thing it returns is like an attachment, but its not an attachment. For instance, it more than likely does not have a name or any attachment data. attachments() returns a list of the attachments that the given TNEF object contains. data() takes a TNEF attribute name, and returns a string value for that attribute for that attachment. Its your own problem if the string is too big for memory. If no argument is given, then the 'AttachData' attribute is assumed, which is probably the data you're looking for. name() is the same as data(), except the attribute 'AttachTitle' is assumed, which returns the 8 character + 3 character extension name of the attachment. longname() returns the long filename and extension of an attachment. This is embedded in the 'Attachment' attribute data, so we attempt to extract the name out of that. size() takes an TNEF attribute name, and returns the size in bytes for the data for that attachment attribute. datahandle() is a method for attachments which takes a TNEF attribute name, and returns the data for that attribute as an object which is the same as a MIME::Body object. See MIME::Body for all the applicable methods. If no argument is given, then 'AttachData' is assumed. SEE ALSO perl(1), IO::Wrap(3), MIME::Parser(3), MIME::Entity(3), MIME::Body(3) CAVEATS The parsing may depend on the endianness (see perlport) and width of integers on the system where the TNEF file was created. If this proves to be the case (check the debug output), I'll see what I can do about it. AUTHOR Douglas Wilson, dougw@cpan.org