rt 4.2.15
[freeside.git] / rt / lib / RT / Action / SendEmail.pm
index 2a7a2e3..8897cb9 100755 (executable)
@@ -2,7 +2,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
@@ -135,13 +135,15 @@ Builds an outgoing email we're going to send using scrip's template.
 sub Prepare {
     my $self = shift;
 
-    my ( $result, $message ) = $self->TemplateObj->Parse(
-        Argument       => $self->Argument,
-        TicketObj      => $self->TicketObj,
-        TransactionObj => $self->TransactionObj
-    );
-    if ( !$result ) {
-        return (undef);
+    unless ( $self->TemplateObj->MIMEObj ) {
+        my ( $result, $message ) = $self->TemplateObj->Parse(
+            Argument       => $self->Argument,
+            TicketObj      => $self->TicketObj,
+            TransactionObj => $self->TransactionObj
+        );
+        if ( !$result ) {
+            return (undef);
+        }
     }
 
     my $MIMEObj = $self->TemplateObj->MIMEObj;
@@ -179,12 +181,6 @@ sub Prepare {
             && !$MIMEObj->head->get('To')
             && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
 
-    # We should never have to set the MIME-Version header
-    $self->SetHeader( 'MIME-Version', '1.0' );
-
-    # fsck.com #5959: Since RT sends 8bit mail, we should say so.
-    $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
-
     # For security reasons, we only send out textual mails.
     foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
         my $type = $part->mime_type || 'text/plain';
@@ -195,9 +191,12 @@ sub Prepare {
         $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
     }
 
-    RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
-        RT->Config->Get('EmailOutputEncoding'),
-        'mime_words_ok', );
+    RT::I18N::SetMIMEEntityToEncoding(
+        Entity        => $MIMEObj,
+        Encoding      => RT->Config->Get('EmailOutputEncoding'),
+        PreserveWords => 1,
+        IsOut         => 1,
+    );
 
     # Build up a MIME::Entity that looks like the original message.
     $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
@@ -218,7 +217,7 @@ sub Prepare {
             'Success';
     }
 
-    return $result;
+    return 1;
 }
 
 =head2 To
@@ -258,7 +257,7 @@ sub Bcc {
 sub AddressesFromHeader {
     my $self      = shift;
     my $field     = shift;
-    my $header    = $self->TemplateObj->MIMEObj->head->get($field);
+    my $header    = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
     my @addresses = Email::Address->parse($header);
 
     return (@addresses);
@@ -277,7 +276,7 @@ sub SendMessage {
     # ability to pass @_ to a 'post' routine.
     my ( $self, $MIMEObj ) = @_;
 
-    my $msgid = $MIMEObj->head->get('Message-ID');
+    my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
     chomp $msgid;
 
     $self->ScripActionObj->{_Message_ID}++;
@@ -300,7 +299,7 @@ sub SendMessage {
 
     my $success = $msgid . " sent ";
     foreach (@EMAIL_RECIPIENT_HEADERS) {
-        my $recipients = $MIMEObj->head->get($_);
+        my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
         $success .= " $_: " . $recipients if $recipients;
     }
 
@@ -318,24 +317,21 @@ sub SendMessage {
     return (1);
 }
 
-=head2 AddAttachments
+=head2 AttachableFromTransaction
 
-Takes any attachments to this transaction and attaches them to the message
-we're building.
+Function (not method) that takes an L<RT::Transaction> and returns an
+L<RT::Attachments> collection of attachments suitable for attaching to an
+email.
 
 =cut
 
-sub AddAttachments {
-    my $self = shift;
-
-    my $MIMEObj = $self->TemplateObj->MIMEObj;
-
-    $MIMEObj->head->delete('RT-Attach-Message');
+sub AttachableFromTransaction {
+    my $txn = shift;
 
     my $attachments = RT::Attachments->new( RT->SystemUser );
     $attachments->Limit(
         FIELD => 'TransactionId',
-        VALUE => $self->TransactionObj->Id
+        VALUE => $txn->Id
     );
 
     # Don't attach anything blank
@@ -345,7 +341,7 @@ sub AddAttachments {
     # We want to make sure that we don't include the attachment that's
     # being used as the "Content" of this message" unless that attachment's
     # content type is not like text/...
-    my $transaction_content_obj = $self->TransactionObj->ContentObj;
+    my $transaction_content_obj = $txn->ContentObj;
 
     if (   $transaction_content_obj
         && $transaction_content_obj->ContentType =~ m{text/}i )
@@ -369,6 +365,25 @@ sub AddAttachments {
         }
     }
 
+    return $attachments;
+}
+
+=head2 AddAttachments
+
+Takes any attachments to this transaction and attaches them to the message
+we're building.
+
+=cut
+
+sub AddAttachments {
+    my $self = shift;
+
+    my $MIMEObj = $self->TemplateObj->MIMEObj;
+
+    $MIMEObj->head->delete('RT-Attach-Message');
+
+    my $attachments = AttachableFromTransaction($self->TransactionObj);
+
     # attach any of this transaction's attachments
     my $seen_attachment = 0;
     while ( my $attach = $attachments->Next ) {
@@ -382,7 +397,7 @@ sub AddAttachments {
 
 =head2 AddAttachment $attachment
 
-Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
+Takes one attachment object of L<RT::Attachment> class and attaches it to the message
 we're building.
 
 =cut
@@ -397,15 +412,17 @@ sub AddAttachment {
               and $attach->TransactionObj->CurrentUserCanSee;
 
     # ->attach expects just the disposition type; extract it if we have the header
+    # or default to "attachment"
     my $disp = ($attach->GetHeader('Content-Disposition') || '')
-                    =~ /^\s*(inline|attachment)/i ? $1 : undef;
+                    =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
 
     $MIMEObj->attach(
         Type        => $attach->ContentType,
         Charset     => $attach->OriginalEncoding,
         Data        => $attach->OriginalContent,
-        Disposition => $disp, # a false value defaults to inline in MIME::Entity
+        Disposition => $disp,
         Filename    => $self->MIMEEncodeString( $attach->Filename ),
+        Id          => $attach->GetHeader('Content-ID'),
         'RT-Attachment:' => $self->TicketObj->Id . "/"
             . $self->TransactionObj->Id . "/"
             . $attach->id,
@@ -461,11 +478,11 @@ sub AddTicket {
 
     my $attachs   = RT::Attachments->new( $self->TransactionObj->CreatorObj );
     my $txn_alias = $attachs->TransactionAlias;
-    $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
     $attachs->Limit(
-        ALIAS => $txn_alias,
-        FIELD => 'Type',
-        VALUE => 'Correspond'
+        ALIAS    => $txn_alias,
+        FIELD    => 'Type',
+        OPERATOR => 'IN',
+        VALUE    => [qw(Create Correspond)],
     );
     $attachs->LimitByTicket($tid);
     $attachs->LimitNotEmpty;
@@ -530,7 +547,7 @@ sub RecordOutgoingMailTransaction {
         $type = 'EmailRecord';
     }
 
-    my $msgid = $MIMEObj->head->get('Message-ID');
+    my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
     chomp $msgid;
 
     my ( $id, $msg ) = $transaction->Create(
@@ -600,24 +617,19 @@ sub SetRTSpecialHeaders {
         }
     }
 
-    if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
-        and !$self->TemplateObj->MIMEObj->head->get("Precedence")
-    ) {
-        $self->SetHeader( 'Precedence', $precedence );
-    }
-
     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
-    $self->SetHeader( 'RT-Ticket',
+    $self->SetHeader( 'X-RT-Ticket',
         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
-    $self->SetHeader( 'Managed-by',
+    $self->SetHeader( 'X-Managed-by',
         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 
 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 #            refactored into user's method.
     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
+         and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator")
          and RT->Config->Get('UseOriginatorHeader')
     ) {
-        $self->SetHeader( 'RT-Originator', $email );
+        $self->SetHeader( 'X-RT-Originator', $email );
     }
 
 }
@@ -648,7 +660,7 @@ sub DeferDigestRecipients {
 
         # Have to get the list of addresses directly from the MIME header
         # at this point.
-        $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
+        $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
             next unless $rcpt;
             my $user_obj = RT::User->new(RT->SystemUser);
@@ -737,15 +749,29 @@ Remove addresses that are RT addresses or that are on this transaction's blackli
 
 =cut
 
+my %squelch_reasons = (
+    'not privileged'
+        => "because autogenerated messages are configured to only be sent to privileged users (RedistributeAutoGeneratedMessages)",
+    'squelch:attachment'
+        => "by RT-Squelch-Replies-To header in the incoming message",
+    'squelch:transaction'
+        => "by notification checkboxes for this transaction",
+    'squelch:ticket'
+        => "by notification checkboxes on this ticket's People page",
+);
+
+
 sub RemoveInappropriateRecipients {
     my $self = shift;
 
-    my @blacklist = ();
+    my %blacklist = ();
 
     # If there are no recipients, don't try to send the message.
     # If the transaction has content and has the header RT-Squelch-Replies-To
 
-    my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
+    my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
+    chomp $msgid;
+
     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 
         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
@@ -754,7 +780,9 @@ sub RemoveInappropriateRecipients {
             # caused by one of the watcher addresses being broken.
             # Default ("true") is to redistribute, for historical reasons.
 
-            if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
+            my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages');
+
+            if ( !$redistribute ) {
 
                 # Don't send to any watchers.
                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
@@ -762,16 +790,15 @@ sub RemoveInappropriateRecipients {
                         . " The incoming message was autogenerated. "
                         . "Not redistributing this message based on site configuration."
                 );
-            } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
-                'privileged' )
-            {
+            } elsif ( $redistribute eq 'privileged' ) {
 
                 # Only send to "privileged" watchers.
                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
                     foreach my $addr ( @{ $self->{$type} } ) {
                         my $user = RT::User->new(RT->SystemUser);
                         $user->LoadByEmail($addr);
-                        push @blacklist, $addr unless $user->id && $user->Privileged;
+                        $blacklist{ $addr } ||= 'not privileged'
+                            unless $user->id && $user->Privileged;
                     }
                 }
                 $RT::Logger->info( $msgid
@@ -782,48 +809,88 @@ sub RemoveInappropriateRecipients {
         }
 
         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
-            push @blacklist, split( /,/, $squelch );
+            $blacklist{ $_->address } ||= 'squelch:attachment'
+                foreach Email::Address->parse( $squelch );
         }
     }
 
-    # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
-    push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
+    # Let's grab the SquelchMailTo attributes and push those entries
+    # into the blacklisted
+    $blacklist{ $_->Content } ||= 'squelch:transaction'
+        foreach $self->TransactionObj->SquelchMailTo;
+    $blacklist{ $_->Content } ||= 'squelch:ticket'
+        foreach $self->TicketObj->SquelchMailTo;
+
+    # canonicalize emails
+    foreach my $address ( keys %blacklist ) {
+        my $reason = delete $blacklist{ $address };
+        $blacklist{ lc $_ } = $reason
+            foreach map RT::User->CanonicalizeEmailAddress( $_->address ),
+            Email::Address->parse( $address );
+    }
+
+    $self->RecipientFilter(
+        Callback => sub {
+            return unless RT::EmailParser->IsRTAddress( $_[0] );
+            return "$_[0] appears to point to this RT instance. Skipping";
+        },
+        All => 1,
+    );
 
-    # Cycle through the people we're sending to and pull out anyone on the
-    # system blacklist
+    $self->RecipientFilter(
+        Callback => sub {
+            return unless $blacklist{ lc $_[0] };
+            return "$_[0] is blacklisted $squelch_reasons{ $blacklist{ lc $_[0] } }. Skipping";
+        },
+    );
 
-    # Trim leading and trailing spaces. 
-    @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
-        Email::Address->parse( join ', ', grep defined, @blacklist );
 
-    foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
+    # Cycle through the people we're sending to and pull out anyone that meets any of the callbacks
+    for my $type (@EMAIL_RECIPIENT_HEADERS) {
         my @addrs;
-        foreach my $addr ( @{ $self->{$type} } ) {
 
-         # Weed out any RT addresses. We really don't want to talk to ourselves!
-         # If we get a reply back, that means it's not an RT address
-            if ( !RT::EmailParser->CullRTAddresses($addr) ) {
-                $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
-                next;
-            }
-            if ( grep $addr eq $_, @blacklist ) {
-                $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
-                next;
+      ADDRESS:
+        for my $addr ( @{ $self->{$type} } ) {
+            for my $filter ( map {$_->{Callback}} @{$self->{RecipientFilter}} ) {
+                my $skip = $filter->($addr);
+                next unless $skip;
+                $RT::Logger->info( "$msgid $skip" );
+                next ADDRESS;
             }
             push @addrs, $addr;
         }
-        foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
-            # never send email to itself
-            if ( !RT::EmailParser->CullRTAddresses($addr) ) {
-                $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
-                next;
+
+      NOSQUELCH_ADDRESS:
+        for my $addr ( @{ $self->{NoSquelch}{$type} } ) {
+            for my $filter ( map {$_->{Callback}} grep {$_->{All}} @{$self->{RecipientFilter}} ) {
+                my $skip = $filter->($addr);
+                next unless $skip;
+                $RT::Logger->info( "$msgid $skip" );
+                next NOSQUELCH_ADDRESS;
             }
             push @addrs, $addr;
         }
+
         @{ $self->{$type} } = @addrs;
     }
 }
 
+=head2 RecipientFilter Callback => SUB, [All => 1]
+
+Registers a filter to be applied to addresses by
+L<RemoveInappropriateRecipients>.  The C<Callback> will be called with
+one address at a time, and should return false if the address should
+receive mail, or a message explaining why it should not be.  Passing a
+true value for C<All> will cause the filter to also be applied to
+NoSquelch (one-time Cc and Bcc) recipients as well.
+
+=cut
+
+sub RecipientFilter {
+    my $self = shift;
+    push @{ $self->{RecipientFilter}}, {@_};
+}
+
 =head2 SetReturnAddress is_comment => BOOLEAN
 
 Calculate and set From and Reply-To headers based on the is_comment flag.
@@ -871,21 +938,25 @@ sub SetFrom {
     my $self = shift;
     my %args = @_;
 
+    my $from = $args{From};
+
     if ( RT->Config->Get('UseFriendlyFromLine') ) {
         my $friendly_name = $self->GetFriendlyName(%args);
-        $self->SetHeader(
-            'From',
+        $from = 
             sprintf(
                 RT->Config->Get('FriendlyFromLineFormat'),
                 $self->MIMEEncodeString(
                     $friendly_name, RT->Config->Get('EmailOutputEncoding')
                 ),
                 $args{From}
-            ),
-        );
-    } else {
-        $self->SetHeader( 'From', $args{From} );
+            );
     }
+
+    $self->SetHeader( 'From', $from );
+
+    #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine,
+    #and then Outlook prepends "rt@machine on behalf of" to the From: header
+    $self->SetHeader( 'Sender', $from );
 }
 
 =head2 GetFriendlyName
@@ -917,7 +988,8 @@ sub GetFriendlyName {
 
 =head2 SetHeader FIELD, VALUE
 
-Set the FIELD of the current MIME object into VALUE.
+Set the FIELD of the current MIME object into VALUE, which should be in
+characters, not bytes.  Returns the new header, in bytes.
 
 =cut
 
@@ -930,7 +1002,7 @@ sub SetHeader {
     chomp $field;
     my $head = $self->TemplateObj->MIMEObj->head;
     $head->fold_length( $field, 10000 );
-    $head->replace( $field, $val );
+    $head->replace( $field, Encode::encode( "UTF-8", $val ) );
     return $head->get($field);
 }
 
@@ -985,11 +1057,12 @@ sub SetSubjectToken {
     my $self = shift;
 
     my $head = $self->TemplateObj->MIMEObj->head;
-    $head->replace(
-        Subject => RT::Interface::Email::AddSubjectTag(
-            Encode::decode_utf8( $head->get('Subject') ),
-            $self->TicketObj,
-        ),
+    $self->SetHeader(
+        Subject =>
+            RT::Interface::Email::AddSubjectTag(
+                Encode::decode( "UTF-8", $head->get('Subject') ),
+                $self->TicketObj,
+            ),
     );
 }
 
@@ -1071,18 +1144,14 @@ Returns a fake Message-ID: header for the ticket to allow a base level of thread
 =cut
 
 sub PseudoReference {
-
     my $self = shift;
-    my $pseudo_ref
-        = '<RT-Ticket-'
-        . $self->TicketObj->id . '@'
-        . RT->Config->Get('Organization') . '>';
-    return $pseudo_ref;
+    return RT::Interface::Email::PseudoReference( $self->TicketObj );
 }
 
 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
 
-This routine converts the field into specified charset encoding.
+This routine converts the field into specified charset encoding, then
+applies the MIME-Header transfer encoding.
 
 =cut
 
@@ -1092,13 +1161,8 @@ sub SetHeaderAsEncoding {
 
     my $head = $self->TemplateObj->MIMEObj->head;
 
-    if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
-        $head->replace( $field, RT->Config->Get('SMTPFrom') );
-        return;
-    }
-
-    my $value = $head->get( $field );
-    $value = $self->MIMEEncodeString( $value, $enc );
+    my $value = Encode::decode("UTF-8", $head->get( $field ));
+    $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
     $head->replace( $field, $value );
 
 }
@@ -1108,7 +1172,8 @@ sub SetHeaderAsEncoding {
 Takes a perl string and optional encoding pass it over
 L<RT::Interface::Email/EncodeToMIME>.
 
-Basicly encode a string using B encoding according to RFC2047.
+Basicly encode a string using B encoding according to RFC2047, returning
+bytes.
 
 =cut