Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / rt / lib / RT / EmailParser.pm
index 63c7698..2954505 100644 (file)
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-# 
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (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) {
@@ -121,10 +122,8 @@ 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;
             }
         }
@@ -233,7 +232,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 +241,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,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<except> the current Queue\'s email addresses, the CurrentUser\'s 
+headers b<except> the current Queue's email addresses, the CurrentUser's 
 email address and anything that the RT->Config->Get('RTAddressRegexp') matches.
 
 =cut
@@ -298,12 +297,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);
@@ -327,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;
     }
@@ -339,7 +340,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;
 
@@ -360,16 +361,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;
 }
 
 
@@ -430,8 +424,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);
 }
 
@@ -534,30 +526,173 @@ 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<Email::Address> objects to make their email addresses
+more palatable.
+
+Currently this strips off surrounding single quotes around C<< ->address >> and
+B<< modifies the L<Email::Address> objects in-place >>.
+
+Returns the list of objects for convienence in C<map>/C<grep> 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;
@@ -567,9 +702,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;