rt 4.0.23
[freeside.git] / rt / lib / RT / EmailParser.pm
index 7890f49..695b744 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) {
@@ -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<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
 
 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<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;
@@ -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;