X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FEmailParser.pm;h=51d5dae10b3dc77c61337a83e213d964e5f17a27;hb=681a340f6be4184b1472a8e1fa9cd5d074f6f325;hp=4cf4184a446dbb2060e53c4e9bb96cde4d115409;hpb=85e677b86fc37c54e6de2b06340351a28f5a5916;p=freeside.git diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm index 4cf4184a4..51d5dae10 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-2016 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) { @@ -122,17 +122,13 @@ sub SmartParseMIMEEntityFromScalar { close($fh); if ( -f $temp_file ) { - # We have to trust the temp file's name -- untaint it - $temp_file =~ /(.*)/; - my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} ); - unlink($1); + my $entity = $self->ParseMIMEEntityFromFile( $temp_file, $args{'Decode'}, $args{'Exact'} ); + unlink($temp_file); return $entity; } } }; - $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 +282,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 +297,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 +326,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; } @@ -528,28 +526,71 @@ we can use that removes the bandaid =cut +use Email::Address::List; + sub ParseEmailAddress { my $self = shift; my $address_string = shift; - $address_string =~ s/^\s+|\s+$//g; + my @list = Email::Address::List->parse( + $address_string, + skip_comments => 1, + skip_groups => 1, + ); + my $logger = sub { RT->Logger->error( + "Unable to parse an email address from $address_string: ". shift + ) }; 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 ($id, $msg) = $user->Load($address_string); - if ($id) { - push @addresses, Email::Address->new($user->Name,$user->EmailAddress); + foreach my $e ( @list ) { + if ($e->{'type'} eq 'mailbox') { + if ($e->{'not_ascii'}) { + $logger->($e->{'value'} ." contains not ASCII values"); + next; + } + push @addresses, $e->{'value'} + } elsif ( $e->{'value'} =~ /^\s*(\w+)\s*$/ ) { + my $user = RT::User->new( RT->SystemUser ); + $user->Load( $1 ); + if ($user->id) { + push @addresses, Email::Address->new($user->Name, $user->EmailAddress); + } else { + $logger->($e->{'value'} ." is not a valid email address and is not user name"); + } } else { - $RT::Logger->error("Unable to parse an email address from $address_string: $msg"); + $logger->($e->{'value'} ." is not a valid email address"); } - } else { - @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 @@ -568,50 +609,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;