rt 4.0.23
[freeside.git] / rt / lib / RT / Interface / Email.pm
index dda6f70..f860461 100755 (executable)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -114,7 +114,7 @@ sub CheckForLoops {
     my $head = shift;
 
     # If this instance of RT sent it our, we don't want to take it in
-    my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
+    my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" );
     chomp ($RTLoop); # remove that newline
     if ( $RTLoop eq RT->Config->Get('rtname') ) {
         return 1;
@@ -149,6 +149,9 @@ sub CheckForSuspiciousSender {
 
     my ( $From, $junk ) = ParseSenderAddressFromHead($head);
 
+    # If unparseable (non-ASCII), $From can come back undef
+    return undef if not defined $From;
+
     if (   ( $From =~ /^mailer-daemon\@/i )
         or ( $From =~ /^postmaster\@/i )
         or ( $From eq "" ))
@@ -222,8 +225,8 @@ add 'In-Reply-To' field to the error that points to this message.
 
 =item Attach - optional text that attached to the error as 'message/rfc822' part.
 
-=item LogLevel - log level under which we should write explanation message into the
-log, by default we log it as critical.
+=item LogLevel - log level under which we should write the subject and
+explanation message into the log, by default we log it as critical.
 
 =back
 
@@ -244,28 +247,33 @@ sub MailError {
 
     $RT::Logger->log(
         level   => $args{'LogLevel'},
-        message => $args{'Explanation'}
+        message => "$args{Subject}: $args{'Explanation'}",
     ) if $args{'LogLevel'};
 
     # the colons are necessary to make ->build include non-standard headers
     my %entity_args = (
         Type                    => "multipart/mixed",
-        From                    => $args{'From'},
-        Bcc                     => $args{'Bcc'},
-        To                      => $args{'To'},
-        Subject                 => $args{'Subject'},
-        'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'),
+        From                    => Encode::encode( "UTF-8", $args{'From'} ),
+        Bcc                     => Encode::encode( "UTF-8", $args{'Bcc'} ),
+        To                      => Encode::encode( "UTF-8", $args{'To'} ),
+        Subject                 => EncodeToMIME( String => $args{'Subject'} ),
+        'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ),
     );
 
     # only set precedence if the sysadmin wants us to
     if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
-        $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence');
+        $entity_args{'Precedence:'} =
+            Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') );
     }
 
     my $entity = MIME::Entity->build(%entity_args);
     SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
 
-    $entity->attach( Data => $args{'Explanation'} . "\n" );
+    $entity->attach(
+        Type    => "text/plain",
+        Charset => "UTF-8",
+        Data    => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ),
+    );
 
     if ( $args{'MIMEObj'} ) {
         $args{'MIMEObj'}->sync_headers;
@@ -273,7 +281,7 @@ sub MailError {
     }
 
     if ( $args{'Attach'} ) {
-        $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
+        $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' );
 
     }
 
@@ -371,7 +379,7 @@ sub SendEmail {
         return 0;
     }
 
-    my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
+    my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
     chomp $msgid;
     
     # If we don't have any recipients to send to, don't send a message;
@@ -408,7 +416,7 @@ sub SendEmail {
         require RT::Date;
         my $date = RT::Date->new( RT->SystemUser );
         $date->SetToNow;
-        $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
+        $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) );
     }
 
     my $mail_command = RT->Config->Get('MailCommand');
@@ -428,21 +436,24 @@ sub SendEmail {
         # SetOutgoingMailFrom and bounces conflict, since they both want -f
         if ( $args{'Bounce'} ) {
             push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
-        } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
-            my $OutgoingMailAddress;
+        } elsif ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) {
+            my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef;
+            my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {};
 
             if ($TicketObj) {
                 my $QueueName = $TicketObj->QueueObj->Name;
-                my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
+                my $QueueAddressOverride = $Overrides->{$QueueName};
 
                 if ($QueueAddressOverride) {
                     $OutgoingMailAddress = $QueueAddressOverride;
                 } else {
-                    $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
+                    $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress
+                                             || RT->Config->Get('CorrespondAddress');
                 }
             }
-
-            $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
+            elsif ($Overrides->{'Default'}) {
+                $OutgoingMailAddress = $Overrides->{'Default'};
+            }
 
             push @args, "-f", $OutgoingMailAddress
                 if $OutgoingMailAddress;
@@ -508,12 +519,13 @@ sub SendEmail {
 
         # duplicate head as we want drop Bcc field
         my $head = $args{'Entity'}->head->dup;
-        my @recipients = map $_->address, map 
-            Email::Address->parse($head->get($_)), qw(To Cc Bcc);                       
+        my @recipients = map $_->address, map
+            Email::Address->parse(Encode::decode("UTF-8", $head->get($_))),
+                  qw(To Cc Bcc);
         $head->delete('Bcc');
 
         my $sender = RT->Config->Get('SMTPFrom')
-            || $args{'Entity'}->head->get('From');
+            || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') );
         chomp $sender;
 
         my $status = $smtp->mail( $sender )
@@ -618,10 +630,10 @@ sub SendEmailUsingTemplate {
         return -1;
     }
 
-    $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
+    $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) )
         foreach grep defined $args{$_}, qw(To Cc Bcc From);
 
-    $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
+    $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) )
         foreach keys %{ $args{ExtraHeaders} };
 
     SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
@@ -754,8 +766,9 @@ sub SendForward {
                 . $txn->id ." of a ticket #". $txn->ObjectId;
         }
         $mail = MIME::Entity->build(
-            Type => 'text/plain',
-            Data => $description,
+            Type    => 'text/plain',
+            Charset => "UTF-8",
+            Data    => Encode::encode( "UTF-8", $description ),
         );
     }
 
@@ -838,7 +851,7 @@ sub SignEncrypt {
     );
     return 1 unless $args{'Sign'} || $args{'Encrypt'};
 
-    my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
+    my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
     chomp $msgid;
 
     $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
@@ -974,9 +987,6 @@ sub EncodeToMIME {
 
     $value =~ s/\s+$//;
 
-    # we need perl string to split thing char by char
-    Encode::_utf8_on($value) unless Encode::is_utf8($value);
-
     my ( $tmp, @chunks ) = ( '', () );
     while ( length $value ) {
         my $char = substr( $value, 0, 1, '' );
@@ -1059,7 +1069,7 @@ sub CreateUser {
 
 Takes a hash 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 configuration sub RT::IsRTAddress matches.
 
 =cut
@@ -1081,7 +1091,8 @@ sub ParseCcAddressesFromHead {
                 && !IgnoreCcAddress( $_ )
              }
         map lc $user->CanonicalizeEmailAddress( $_->address ),
-        map Email::Address->parse( $args{'Head'}->get( $_ ) ),
+        map RT::EmailParser->CleanupAddresses( Email::Address->parse(
+              Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ),
         qw(To Cc);
 }
 
@@ -1101,23 +1112,34 @@ sub IgnoreCcAddress {
 
 =head2 ParseSenderAddressFromHead HEAD
 
-Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
-of the From (evaluated in order of Reply-To:, From:, Sender)
+Takes a MIME::Header object. Returns (user@host, friendly name, errors)
+where the first two values are the From (evaluated in order of
+Reply-To:, From:, Sender).
+
+A list of error messages may be returned even when a Sender value is
+found, since it could be a parse error for another (checked earlier)
+sender field. In this case, the errors aren't fatal, but may be useful
+to investigate the parse failure.
 
 =cut
 
 sub ParseSenderAddressFromHead {
     my $head = shift;
+    my @sender_headers = ('Reply-To', 'From', 'Sender');
+    my @errors;  # Accumulate any errors
 
     #Figure out who's sending this message.
-    foreach my $header ('Reply-To', 'From', 'Sender') {
-        my $addr_line = $head->get($header) || next;
+    foreach my $header ( @sender_headers ) {
+        my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next;
         my ($addr, $name) = ParseAddressFromHeader( $addr_line );
         # only return if the address is not empty
-        return ($addr, $name) if $addr;
+        return ($addr, $name, @errors) if $addr;
+
+        chomp $addr_line;
+        push @errors, "$header: $addr_line";
     }
 
-    return (undef, undef);
+    return (undef, undef, @errors);
 }
 
 =head2 ParseErrorsToAddressFromHead HEAD
@@ -1136,7 +1158,7 @@ sub ParseErrorsToAddressFromHead {
     foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
 
         # If there's a header of that name
-        my $headerobj = $head->get($header);
+        my $headerobj = Encode::decode( "UTF-8", $head->get($header) );
         if ($headerobj) {
             my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
 
@@ -1181,9 +1203,9 @@ sub DeleteRecipientsFromHead {
     my %skip = map { lc $_ => 1 } @_;
 
     foreach my $field ( qw(To Cc Bcc) ) {
-        $head->set( $field =>
+        $head->set( $field => Encode::encode( "UTF-8",
             join ', ', map $_->format, grep !$skip{ lc $_->address },
-                Email::Address->parse( $head->get( $field ) )
+                Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) )
         );
     }
 }
@@ -1216,7 +1238,7 @@ sub SetInReplyTo {
     my $get_header = sub {
         my @res;
         if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
-            @res = $args{'InReplyTo'}->head->get( shift );
+            @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift );
         } else {
             @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
         }
@@ -1239,14 +1261,14 @@ sub SetInReplyTo {
         if @references > 10;
 
     my $mail = $args{'Message'};
-    $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
-    $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) );
+    $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
+    $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) );
 }
 
 sub ExtractTicketId {
     my $entity = shift;
 
-    my $subject = $entity->head->get('Subject') || '';
+    my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' );
     chomp $subject;
     return ParseTicketId( $subject );
 }
@@ -1445,16 +1467,20 @@ sub Gateway {
     }
     @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
     $parser->_DecodeBodies;
+    $parser->RescueOutlook;
     $parser->_PostProcessNewEntity;
 
     my $head = $Message->head;
     my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
+    my $Sender = (ParseSenderAddressFromHead( $head ))[0];
+    my $From = Encode::decode( "UTF-8", $head->get("From") );
+    chomp $From if defined $From;
 
-    my $MessageId = $head->get('Message-ID')
+    my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') )
         || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
 
     #Pull apart the subject line
-    my $Subject = $head->get('Subject') || '';
+    my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || '');
     chomp $Subject;
     
     # Lets check for mail loops of various sorts.
@@ -1476,6 +1502,10 @@ sub Gateway {
 
     $args{'ticket'} ||= ExtractTicketId( $Message );
 
+    # ExtractTicketId may have been overridden, and edited the Subject
+    my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') );
+    chomp $NewSubject;
+
     $SystemTicket = RT::Ticket->new( RT->SystemUser );
     $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
     if ( $SystemTicket->id ) {
@@ -1529,7 +1559,8 @@ sub Gateway {
         );
         return (
             0,
-            "$ErrorsTo tried to submit a message to "
+            ($CurrentUser->EmailAddress || $CurrentUser->Name)
+            . " ($Sender) tried to submit a message to "
                 . $args{'Queue'}
                 . " without permission.",
             undef
@@ -1560,9 +1591,11 @@ sub Gateway {
             );
         }
 
+        $head->replace('X-RT-Interface' => 'Email');
+
         my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
             Queue     => $SystemQueueObj->Id,
-            Subject   => $Subject,
+            Subject   => $NewSubject,
             Requestor => \@Requestors,
             Cc        => \@Cc,
             MIMEObj   => $Message
@@ -1574,7 +1607,7 @@ sub Gateway {
                 Explanation => $ErrStr,
                 MIMEObj     => $Message
             );
-            return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
+            return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket );
         }
 
         # strip comments&corresponds from the actions we don't need
@@ -1615,11 +1648,11 @@ sub Gateway {
                 #Warn the sender that we couldn't actually submit the comment.
                 MailError(
                     To          => $ErrorsTo,
-                    Subject     => "Message not recorded: $Subject",
+                    Subject     => "Message not recorded ($method): $Subject",
                     Explanation => $msg,
                     MIMEObj     => $Message
                 );
-                return ( 0, "Message not recorded: $msg", $Ticket );
+                return ( 0, "Message From: $From not recorded: $msg", $Ticket );
             }
         } elsif ($unsafe_actions) {
             my ( $status, $msg ) = _RunUnsafeAction(
@@ -1718,6 +1751,8 @@ sub _RunUnsafeAction {
         @_
     );
 
+    my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") );
+
     if ( $args{'Action'} =~ /^take$/i ) {
         my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
         unless ($status) {
@@ -1727,7 +1762,7 @@ sub _RunUnsafeAction {
                 Explanation => $msg,
                 MIMEObj     => $args{'Message'}
             );
-            return ( 0, "Ticket not taken" );
+            return ( 0, "Ticket not taken, by email From: $From" );
         }
     } elsif ( $args{'Action'} =~ /^resolve$/i ) {
         my $new_status = $args{'Ticket'}->FirstInactiveStatus;
@@ -1742,11 +1777,11 @@ sub _RunUnsafeAction {
                     Explanation => $msg,
                     MIMEObj     => $args{'Message'}
                 );
-                return ( 0, "Ticket not resolved" );
+                return ( 0, "Ticket not resolved, by email From: $From" );
             }
         }
     } else {
-        return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
+        return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} );
     }
     return ( 1, "Success" );
 }
@@ -1872,7 +1907,7 @@ sub _HandleMachineGeneratedMail {
         # to the scrip. We might want to notify nobody. Or just
         # the RT Owner. Or maybe all Privileged watchers.
         my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
-        $head->replace( 'RT-Squelch-Replies-To',    $Sender );
+        $head->replace( 'RT-Squelch-Replies-To',    Encode::encode("UTF-8", $Sender ) );
         $head->replace( 'RT-DetectedAutoGenerated', 'true' );
     }
     return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );