X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FEmailParser.pm;h=695b7449fbe5bf809c6ac501365261f6ab032e92;hp=dd73d9049feb7b1cae918648e4ac1b804d1ce32e;hb=919e930aa9279b3c5cd12b593889cd6de79d67bf;hpb=8c450aab9bae89373c2c1b35c85597bb52299de3 diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index dd73d9049..695b7449f 100644 --- a/rt/lib/RT/EmailParser.pm +++ b/rt/lib/RT/EmailParser.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -110,7 +110,7 @@ sub SmartParseMIMEEntityFromScalar { # accommodate this by pausing and retrying. last if ( $fh, $temp_file ) = - eval { File::Temp::tempfile( undef, UNLINK => 0 ) }; + eval { File::Temp::tempfile( UNLINK => 0 ) }; sleep 1; } if ($fh) { @@ -131,8 +131,6 @@ sub SmartParseMIMEEntityFromScalar { } }; - $self->RescueOutlook; - #If for some reason we weren't able to parse the message using a temp file # try it with a scalar if ( $@ || !$self->Entity ) { @@ -286,7 +284,7 @@ sub _PostProcessNewEntity { Takes a hashref object containing QueueObj, Head and CurrentUser objects. Returns a list of all email addresses in the To and Cc -headers b the current Queue\'s email addresses, the CurrentUser\'s +headers b the current Queue's email addresses, the CurrentUser's email address and anything that the RT->Config->Get('RTAddressRegexp') matches. =cut @@ -301,8 +299,8 @@ sub ParseCcAddressesFromHead { my (@Addresses); - my @ToObjs = Email::Address->parse( $self->Head->get('To') ); - my @CcObjs = Email::Address->parse( $self->Head->get('Cc') ); + my @ToObjs = Email::Address->parse( Encode::decode( "UTF-8", $self->Head->get('To') ) ); + my @CcObjs = Email::Address->parse( Encode::decode( "UTF-8", $self->Head->get('Cc') ) ); foreach my $AddrObj ( @ToObjs, @CcObjs ) { my $Address = $AddrObj->address; @@ -330,6 +328,8 @@ sub IsRTAddress { my $self = shift; my $address = shift; + return undef unless defined($address) and $address =~ /\S/; + if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) { return $address =~ /$address_re/i ? 1 : undef; } @@ -548,10 +548,38 @@ sub ParseEmailAddress { @addresses = Email::Address->parse($address_string); } + $self->CleanupAddresses(@addresses); + return @addresses; } +=head2 CleanupAddresses ARRAY + +Massages an array of L objects to make their email addresses +more palatable. + +Currently this strips off surrounding single quotes around C<< ->address >> and +B<< modifies the L objects in-place >>. + +Returns the list of objects for convienence in C/C chains. + +=cut + +sub CleanupAddresses { + my $self = shift; + + for my $addr (@_) { + next unless defined $addr; + # Outlook sometimes sends addresses surrounded by single quotes; + # clean them all up + if ((my $email = $addr->address) =~ s/^'(.+)'$/$1/) { + $addr->address($email); + } + } + return @_; +} + =head2 RescueOutlook Outlook 2007/2010 have a bug when you write an email with the html format. @@ -568,50 +596,90 @@ return 1 if it does find the problem in the entity and get it fixed. sub RescueOutlook { my $self = shift; my $mime = $self->Entity(); - return unless $mime; - - my $mailer = $mime->head->get('X-Mailer'); - # 12.0 is outlook 2007, 14.0 is 2010 - if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ ) { - my $text_part; - if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) { - my $first = $mime->parts(0); - if ( $first && $first->head->get('Content-Type') =~ m{multipart/alternative} ) + return unless $mime && $self->LooksLikeMSEmail($mime); + + my $text_part; + if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) { + my $first = $mime->parts(0); + if ( $first && $first->head->get('Content-Type') =~ m{multipart/alternative} ) + { + my $inner_first = $first->parts(0); + if ( $inner_first && $inner_first->head->get('Content-Type') =~ m{text/plain} ) { - my $inner_first = $first->parts(0); - if ( $inner_first && $inner_first->head->get('Content-Type') =~ m{text/plain} ) - { - $text_part = $inner_first; - } + $text_part = $inner_first; } } - elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) { - my $first = $mime->parts(0); - if ( $first && $first->head->get('Content-Type') =~ m{text/plain} ) { - $text_part = $first; - } + } + elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) { + my $first = $mime->parts(0); + if ( $first && $first->head->get('Content-Type') =~ m{text/plain} ) { + $text_part = $first; } + } - if ($text_part) { - - # use the unencoded string - my $content = $text_part->bodyhandle->as_string; - if ( $content =~ s/\n\n/\n/g ) { - # only write only if we did change the content - if ( my $io = $text_part->open("w") ) { - $io->print($content); - $io->close; - return 1; - } - else { - $RT::Logger->error("can't write to body"); - } + # Add base64 since we've seen examples of double newlines with + # this type too. Need an example of a multi-part base64 to + # handle that permutation if it exists. + elsif ( ($mime->head->get('Content-Transfer-Encoding')||'') =~ m{base64} ) { + $text_part = $mime; # Assuming single part, already decoded. + } + + if ($text_part) { + + # use the unencoded string + my $content = $text_part->bodyhandle->as_string; + if ( $content =~ s/\n\n/\n/g ) { + + # Outlook puts a space on extra newlines, remove it + $content =~ s/\ +$//mg; + + # only write only if we did change the content + if ( my $io = $text_part->open("w") ) { + $io->print($content); + $io->close; + $RT::Logger->debug( + "Removed extra newlines from MS Outlook message."); + return 1; + } + else { + $RT::Logger->error("Can't write to body to fix newlines"); } } } + return; } +=head1 LooksLikeMSEmail + +Try to determine if the current email may have +come from MS Outlook or gone through Exchange, and therefore +may have extra newlines added. + +=cut + +sub LooksLikeMSEmail { + my $self = shift; + my $mime = shift; + + my $mailer = $mime->head->get('X-Mailer'); + + # 12.0 is outlook 2007, 14.0 is 2010 + return 1 if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ ); + + if ( RT->Config->Get('CheckMoreMSMailHeaders') ) { + + # Check for additional headers that might + # indicate this came from Outlook or through Exchange. + # A sample we received had the headers X-MS-Has-Attach: and + # X-MS-Tnef-Correlator: and both had no value. + + my @tags = $mime->head->tags(); + return 1 if grep { /^X-MS-/ } @tags; + } + + return 0; # Doesn't look like MS email. +} sub DESTROY { my $self = shift;