X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FEmailParser.pm;h=695b7449fbe5bf809c6ac501365261f6ab032e92;hp=7890f495f572879cb9a22c565d4b093ff2c1326f;hb=919e930aa9279b3c5cd12b593889cd6de79d67bf;hpb=b4b0c7e72d7eaee2fbfc7022022c9698323203dd diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index 7890f495f..695b7449f 100644 --- a/rt/lib/RT/EmailParser.pm +++ b/rt/lib/RT/EmailParser.pm @@ -1,40 +1,40 @@ # BEGIN BPS TAGGED BLOCK {{{ -# +# # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# -# +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# +# # (Except where explicitly superseded by other copyright notices) -# -# +# +# # LICENSE: -# +# # This work is made available to you under the terms of Version 2 of # the GNU General Public License. A copy of that license should have # been provided with this software, but in any event can be snarfed # from www.gnu.org. -# +# # This work is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 or visit their web page on the internet at # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# +# +# # CONTRIBUTION SUBMISSION POLICY: -# +# # (The following paragraph is not intended to limit the rights granted # to you to modify and distribute this software under the terms of # the GNU General Public License and is only of importance to you if # you choose to contribute your changes and enhancements to the # community by submitting them to Best Practical Solutions, LLC.) -# +# # By intentionally submitting any modifications, corrections or # derivatives to this work, or any other work intended for use with # Request Tracker, to Best Practical Solutions, LLC, you confirm that @@ -43,7 +43,7 @@ # royalty-free, perpetual, license to use, copy, create derivative # works based on those contributions, and sublicense and distribute # those contributions and any derivatives thereof. -# +# # END BPS TAGGED BLOCK }}} package RT::EmailParser; @@ -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) { @@ -233,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); @@ -242,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); @@ -283,15 +284,13 @@ 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 sub ParseCcAddressesFromHead { - my $self = shift; - my %args = ( QueueObj => undef, CurrentUser => undef, @@ -300,17 +299,15 @@ 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 ( lc $args{'QueueObj'}->CorrespondAddress eq lc $Address ); - next if ( lc $args{'QueueObj'}->CommentAddress eq lc $Address ); - next if ( $self->IsRTAddress($Address) ); + next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address; + next if $self->IsRTAddress($Address); push ( @Addresses, $Address ); } @@ -318,8 +315,6 @@ sub ParseCcAddressesFromHead { } - - =head2 IsRTaddress ADDRESS Takes a single parameter, an email address. @@ -333,16 +328,29 @@ sub IsRTAddress { my $self = shift; my $address = shift; - # Example: the following rule would tell RT not to Cc - # "tickets@noc.example.com" - my $address_re = RT->Config->Get('RTAddressRegexp'); - if ( defined $address_re && $address =~ /$address_re/i ) { - return 1; + return undef unless defined($address) and $address =~ /\S/; + + if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) { + return $address =~ /$address_re/i ? 1 : undef; } - return undef; -} + # we don't warn here, but do in config check + if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) { + return 1 if lc $correspond_address eq lc $address; + } + if ( my $comment_address = RT->Config->Get('CommentAddress') ) { + return 1 if lc $comment_address eq lc $address; + } + + my $queue = RT::Queue->new( RT->SystemUser ); + $queue->LoadByCols( CorrespondAddress => $address ); + return 1 if $queue->id; + + $queue->LoadByCols( CommentAddress => $address ); + return 1 if $queue->id; + return undef; +} =head2 CullRTAddresses ARRAY @@ -355,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; } @@ -425,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); } @@ -538,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); @@ -549,10 +548,138 @@ 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. +it will send a 'multipart/alternative' with both 'text/plain' and 'text/html' +in it. it's cool to have a 'text/plain' part, but the problem is the part is +not so right: all the "\n" in your main message will become "\n\n" :/ + +this method will fix this bug, i.e. replaces "\n\n" to "\n". +return 1 if it does find the problem in the entity and get it fixed. + +=cut + + +sub RescueOutlook { + my $self = shift; + my $mime = $self->Entity(); + 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} ) + { + $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; + } + } + + # 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; @@ -562,9 +689,6 @@ sub DESTROY { -eval "require RT::EmailParser_Vendor"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm}); -eval "require RT::EmailParser_Local"; -die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Local.pm}); +RT::Base->_ImportOverlays(); 1;