X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FEmailParser.pm;h=695b7449fbe5bf809c6ac501365261f6ab032e92;hp=a0affd962c96527fc8308047d2d81b9879c27008;hb=919e930aa9279b3c5cd12b593889cd6de79d67bf;hpb=75162bb14b3e38d66617077843f4dfdcaf09d5c4 diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index a0affd962..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-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -54,6 +54,7 @@ use base qw/RT::Base/; use strict; use warnings; + use Email::Address; use MIME::Entity; use MIME::Head; @@ -109,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) { @@ -130,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 ) { @@ -235,7 +234,7 @@ sub _DecodeBody { require MIME::Decoder; my $encoding = $entity->head->mime_encoding; - my $decoder = new MIME::Decoder $encoding; + my $decoder = MIME::Decoder->new($encoding); unless ( $decoder ) { $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary"); $old->is_encoded(0); @@ -244,7 +243,7 @@ sub _DecodeBody { require MIME::Body; # XXX: use InCore for now, but later must switch to files - my $new = new MIME::Body::InCore; + my $new = MIME::Body::InCore->new(); $new->binmode(1); $new->is_encoded(0); @@ -285,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 @@ -300,12 +299,12 @@ 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; - my $user = RT::User->new($RT::SystemUser); + my $user = RT::User->new(RT->SystemUser); $Address = $user->CanonicalizeEmailAddress($Address); next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address; next if $self->IsRTAddress($Address); @@ -329,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; } @@ -341,7 +342,7 @@ sub IsRTAddress { return 1 if lc $comment_address eq lc $address; } - my $queue = RT::Queue->new( $RT::SystemUser ); + my $queue = RT::Queue->new( RT->SystemUser ); $queue->LoadByCols( CorrespondAddress => $address ); return 1 if $queue->id; @@ -362,16 +363,9 @@ Returns the same array with any IsRTAddress()es weeded out. sub CullRTAddresses { my $self = shift; - my @addresses= (@_); - my @addrlist; - - foreach my $addr( @addresses ) { - # We use the class instead of the instance - # because sloppy code calls this method - # without a $self - push (@addrlist, $addr) unless RT::EmailParser->IsRTAddress($addr); - } - return (@addrlist); + my @addresses = (@_); + + return grep { !$self->IsRTAddress($_) } @addresses; } @@ -432,8 +426,6 @@ sub LookupExternalUserInfo { $params{'EmailAddress'} = $EmailAddress; $params{'RealName'} = $RealName; - # See RT's contributed code for examples. - # http://www.fsck.com/pub/rt/contrib/ return ($FoundInExternalDatabase, %params); } @@ -545,7 +537,7 @@ sub ParseEmailAddress { my @addresses; # if it looks like a username / local only email if ($address_string !~ /@/ && $address_string =~ /^\w+$/) { - my $user = RT::User->new( $RT::SystemUser ); + my $user = RT::User->new( RT->SystemUser ); my ($id, $msg) = $user->Load($address_string); if ($id) { push @addresses, Email::Address->new($user->Name,$user->EmailAddress); @@ -556,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. @@ -576,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->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->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->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; } + } + + # 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; - 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"); - } + # 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;