rt/lib/RT/Action/SendEmail.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
  50
  51 package RT::Action::SendEmail;
  52
  53 use strict;
  54 use warnings;
  55
  56 use base qw(RT::Action);
  57
  58 use RT::EmailParser;
  59 use RT::Interface::Email;
  60 use Email::Address;
  61 our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
  62
  63
  64 =head1 NAME
  65
  66 RT::Action::SendEmail - An Action which users can use to send mail
  67 or can subclassed for more specialized mail sending behavior.
  68 RT::Action::AutoReply is a good example subclass.
  69
  70 =head1 SYNOPSIS
  71
  72   use base 'RT::Action::SendEmail';
  73
  74 =head1 DESCRIPTION
  75
  76 Basically, you create another module RT::Action::YourAction which ISA
  77 RT::Action::SendEmail.
  78
  79 =head1 METHODS
  80
  81 =head2 CleanSlate
  82
  83 Cleans class-wide options, like L</SquelchMailTo> or L</AttachTickets>.
  84
  85 =cut
  86
  87 sub CleanSlate {
  88     my $self = shift;
  89     $self->SquelchMailTo(undef);
  90     $self->AttachTickets(undef);
  91 }
  92
  93 =head2 Commit
  94
  95 Sends the prepared message and writes outgoing record into DB if the feature is
  96 activated in the config.
  97
  98 =cut
  99
 100 sub Commit {
 101     my $self = shift;
 102
 103     return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
 104         unless RT->Config->Get('RecordOutgoingEmail');
 105
 106     $self->DeferDigestRecipients();
 107     my $message = $self->TemplateObj->MIMEObj;
 108
 109     my $orig_message;
 110     $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
 111         Attachment => $self->TransactionObj->Attachments->First,
 112         Ticket     => $self->TicketObj,
 113     );
 114
 115     my ($ret) = $self->SendMessage($message);
 116     return abs( $ret ) if $ret <= 0;
 117
 118     if ($orig_message) {
 119         $message->attach(
 120             Type        => 'application/x-rt-original-message',
 121             Disposition => 'inline',
 122             Data        => $orig_message->as_string,
 123         );
 124     }
 125     $self->RecordOutgoingMailTransaction($message);
 126     $self->RecordDeferredRecipients();
 127     return 1;
 128 }
 129
 130 =head2 Prepare
 131
 132 Builds an outgoing email we're going to send using scrip's template.
 133
 134 =cut
 135
 136 sub Prepare {
 137     my $self = shift;
 138
 139     my ( $result, $message ) = $self->TemplateObj->Parse(
 140         Argument       => $self->Argument,
 141         TicketObj      => $self->TicketObj,
 142         TransactionObj => $self->TransactionObj
 143     );
 144     if ( !$result ) {
 145         return (undef);
 146     }
 147
 148     my $MIMEObj = $self->TemplateObj->MIMEObj;
 149
 150     # Header
 151     $self->SetRTSpecialHeaders();
 152
 153     $self->RemoveInappropriateRecipients();
 154
 155     my %seen;
 156     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 157         @{ $self->{$type} }
 158             = grep defined && length && !$seen{ lc $_ }++,
 159             @{ $self->{$type} };
 160     }
 161
 162     # Go add all the Tos, Ccs and Bccs that we need to to the message to
 163     # make it happy, but only if we actually have values in those arrays.
 164
 165 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
 166
 167     for my $header (@EMAIL_RECIPIENT_HEADERS) {
 168
 169         $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
 170           if (!$MIMEObj->head->get($header)
 171             && $self->{$header}
 172             && @{ $self->{$header} } );
 173     }
 174     # PseudoTo (fake to headers) shouldn't get matched for message recipients.
 175     # If we don't have any 'To' header (but do have other recipients), drop in
 176     # the pseudo-to header.
 177     $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
 178         if $self->{'PseudoTo'}
 179             && @{ $self->{'PseudoTo'} }
 180             && !$MIMEObj->head->get('To')
 181             && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
 182
 183     # We should never have to set the MIME-Version header
 184     $self->SetHeader( 'MIME-Version', '1.0' );
 185
 186     # fsck.com #5959: Since RT sends 8bit mail, we should say so.
 187     $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
 188
 189     # For security reasons, we only send out textual mails.
 190     foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
 191         my $type = $part->mime_type || 'text/plain';
 192         $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
 193         $part->head->mime_attr( "Content-Type" => $type );
 194         # utf-8 here is for _FindOrGuessCharset in I18N.pm
 195         # it's not the final charset/encoding sent
 196         $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 197     }
 198
 199     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
 200         RT->Config->Get('EmailOutputEncoding'),
 201         'mime_words_ok', );
 202
 203     # Build up a MIME::Entity that looks like the original message.
 204     $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
 205                                && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
 206
 207     $self->AddTickets;
 208
 209     my $attachment = $self->TransactionObj->Attachments->First;
 210     if ($attachment
 211         && !(
 212                $attachment->GetHeader('X-RT-Encrypt')
 213             || $self->TicketObj->QueueObj->Encrypt
 214         )
 215         )
 216     {
 217         $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
 218             if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
 219             'Success';
 220     }
 221
 222     return $result;
 223 }
 224
 225 =head2 To
 226
 227 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
 228
 229 =cut
 230
 231 sub To {
 232     my $self = shift;
 233     return ( $self->AddressesFromHeader('To') );
 234 }
 235
 236 =head2 Cc
 237
 238 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
 239
 240 =cut
 241
 242 sub Cc {
 243     my $self = shift;
 244     return ( $self->AddressesFromHeader('Cc') );
 245 }
 246
 247 =head2 Bcc
 248
 249 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
 250
 251 =cut
 252
 253 sub Bcc {
 254     my $self = shift;
 255     return ( $self->AddressesFromHeader('Bcc') );
 256
 257 }
 258
 259 sub AddressesFromHeader {
 260     my $self      = shift;
 261     my $field     = shift;
 262     my $header    = $self->TemplateObj->MIMEObj->head->get($field);
 263     my @addresses = Email::Address->parse($header);
 264
 265     return (@addresses);
 266 }
 267
 268 =head2 SendMessage MIMEObj
 269
 270 sends the message using RT's preferred API.
 271 TODO: Break this out to a separate module
 272
 273 =cut
 274
 275 sub SendMessage {
 276
 277     # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
 278     # ability to pass @_ to a 'post' routine.
 279     my ( $self, $MIMEObj ) = @_;
 280
 281     my $msgid = $MIMEObj->head->get('Message-ID');
 282     chomp $msgid;
 283
 284     $self->ScripActionObj->{_Message_ID}++;
 285
 286     $RT::Logger->info( $msgid . " #"
 287             . $self->TicketObj->id . "/"
 288             . $self->TransactionObj->id
 289             . " - Scrip "
 290             . ($self->ScripObj->id || '#rule'). " "
 291             . ( $self->ScripObj->Description || '' ) );
 292
 293     my $status = RT::Interface::Email::SendEmail(
 294         Entity      => $MIMEObj,
 295         Ticket      => $self->TicketObj,
 296         Transaction => $self->TransactionObj,
 297     );
 298
 299
 300     return $status unless ($status > 0 || exists $self->{'Deferred'});
 301
 302     my $success = $msgid . " sent ";
 303     foreach (@EMAIL_RECIPIENT_HEADERS) {
 304         my $recipients = $MIMEObj->head->get($_);
 305         $success .= " $_: " . $recipients if $recipients;
 306     }
 307
 308     if( exists $self->{'Deferred'} ) {
 309         for (qw(daily weekly susp)) {
 310             $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
 311                 if exists $self->{'Deferred'}{ $_ };
 312         }
 313     }
 314
 315     $success =~ s/\n//g;
 316
 317     $RT::Logger->info($success);
 318
 319     return (1);
 320 }
 321
 322 =head2 AddAttachments
 323
 324 Takes any attachments to this transaction and attaches them to the message
 325 we're building.
 326
 327 =cut
 328
 329 sub AddAttachments {
 330     my $self = shift;
 331
 332     my $MIMEObj = $self->TemplateObj->MIMEObj;
 333
 334     $MIMEObj->head->delete('RT-Attach-Message');
 335
 336     my $attachments = RT::Attachments->new($RT::SystemUser);
 337     $attachments->Limit(
 338         FIELD => 'TransactionId',
 339         VALUE => $self->TransactionObj->Id
 340     );
 341
 342     # Don't attach anything blank
 343     $attachments->LimitNotEmpty;
 344     $attachments->OrderBy( FIELD => 'id' );
 345
 346     # We want to make sure that we don't include the attachment that's
 347     # being used as the "Content" of this message" unless that attachment's
 348     # content type is not like text/...
 349     my $transaction_content_obj = $self->TransactionObj->ContentObj;
 350
 351     if (   $transaction_content_obj
 352         && $transaction_content_obj->ContentType =~ m{text/}i )
 353     {
 354         # If this was part of a multipart/alternative, skip all of the kids
 355         my $parent = $transaction_content_obj->ParentObj;
 356         if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
 357             $attachments->Limit(
 358                 ENTRYAGGREGATOR => 'AND',
 359                 FIELD           => 'parent',
 360                 OPERATOR        => '!=',
 361                 VALUE           => $parent->Id,
 362             );
 363         } else {
 364             $attachments->Limit(
 365                 ENTRYAGGREGATOR => 'AND',
 366                 FIELD           => 'id',
 367                 OPERATOR        => '!=',
 368                 VALUE           => $transaction_content_obj->Id,
 369             );
 370         }
 371     }
 372
 373     # attach any of this transaction's attachments
 374     my $seen_attachment = 0;
 375     while ( my $attach = $attachments->Next ) {
 376         if ( !$seen_attachment ) {
 377             $MIMEObj->make_multipart( 'mixed', Force => 1 );
 378             $seen_attachment = 1;
 379         }
 380         $self->AddAttachment($attach);
 381     }
 382 }
 383
 384 =head2 AddAttachment $attachment
 385
 386 Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
 387 we're building.
 388
 389 =cut
 390
 391 sub AddAttachment {
 392     my $self    = shift;
 393     my $attach  = shift;
 394     my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
 395
 396     # $attach->TransactionObj may not always be $self->TransactionObj
 397     return unless $attach->Id
 398               and $attach->TransactionObj->CurrentUserCanSee;
 399
 400     $MIMEObj->attach(
 401         Type     => $attach->ContentType,
 402         Charset  => $attach->OriginalEncoding,
 403         Data     => $attach->OriginalContent,
 404         Filename => $self->MIMEEncodeString( $attach->Filename ),
 405         'RT-Attachment:' => $self->TicketObj->Id . "/"
 406             . $self->TransactionObj->Id . "/"
 407             . $attach->id,
 408         Encoding => '-SUGGEST',
 409     );
 410 }
 411
 412 =head2 AttachTickets [@IDs]
 413
 414 Returns or set list of ticket's IDs that should be attached to an outgoing message.
 415
 416 B<Note> this method works as a class method and setup things global, so you have to
 417 clean list by passing undef as argument.
 418
 419 =cut
 420
 421 {
 422     my $list = [];
 423
 424     sub AttachTickets {
 425         my $self = shift;
 426         $list = [ grep defined, @_ ] if @_;
 427         return @$list;
 428     }
 429 }
 430
 431 =head2 AddTickets
 432
 433 Attaches tickets to the current message, list of tickets' ids get from
 434 L</AttachTickets> method.
 435
 436 =cut
 437
 438 sub AddTickets {
 439     my $self = shift;
 440     $self->AddTicket($_) foreach $self->AttachTickets;
 441     return;
 442 }
 443
 444 =head2 AddTicket $ID
 445
 446 Attaches a ticket with ID to the message.
 447
 448 Each ticket is attached as multipart entity and all its messages and attachments
 449 are attached as sub entities in order of creation, but only if transaction type
 450 is Create or Correspond.
 451
 452 =cut
 453
 454 sub AddTicket {
 455     my $self = shift;
 456     my $tid  = shift;
 457
 458     my $attachs   = RT::Attachments->new( RT::CurrentUser->new($self->TransactionObj->Creator) );
 459     my $txn_alias = $attachs->TransactionAlias;
 460     $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
 461     $attachs->Limit(
 462         ALIAS => $txn_alias,
 463         FIELD => 'Type',
 464         VALUE => 'Correspond'
 465     );
 466     $attachs->LimitByTicket($tid);
 467     $attachs->LimitNotEmpty;
 468     $attachs->OrderBy( FIELD => 'Created' );
 469
 470     my $ticket_mime = MIME::Entity->build(
 471         Type        => 'multipart/mixed',
 472         Top         => 0,
 473         Description => "ticket #$tid",
 474     );
 475     while ( my $attachment = $attachs->Next ) {
 476         $self->AddAttachment( $attachment, $ticket_mime );
 477     }
 478     if ( $ticket_mime->parts ) {
 479         my $email_mime = $self->TemplateObj->MIMEObj;
 480         $email_mime->make_multipart;
 481         $email_mime->add_part($ticket_mime);
 482     }
 483     return;
 484 }
 485
 486 =head2 RecordOutgoingMailTransaction MIMEObj
 487
 488 Record a transaction in RT with this outgoing message for future record-keeping purposes
 489
 490 =cut
 491
 492 sub RecordOutgoingMailTransaction {
 493     my $self    = shift;
 494     my $MIMEObj = shift;
 495
 496     my @parts = $MIMEObj->parts;
 497     my @attachments;
 498     my @keep;
 499     foreach my $part (@parts) {
 500         my $attach = $part->head->get('RT-Attachment');
 501         if ($attach) {
 502             $RT::Logger->debug(
 503                 "We found an attachment. we want to not record it.");
 504             push @attachments, $attach;
 505         } else {
 506             $RT::Logger->debug("We found a part. we want to record it.");
 507             push @keep, $part;
 508         }
 509     }
 510     $MIMEObj->parts( \@keep );
 511     foreach my $attachment (@attachments) {
 512         $MIMEObj->head->add( 'RT-Attachment', $attachment );
 513     }
 514
 515     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 516
 517     my $transaction
 518         = RT::Transaction->new( $self->TransactionObj->CurrentUser );
 519
 520 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 521
 522     my $type;
 523     if ( $self->TransactionObj->Type eq 'Comment' ) {
 524         $type = 'CommentEmailRecord';
 525     } else {
 526         $type = 'EmailRecord';
 527     }
 528
 529     my $msgid = $MIMEObj->head->get('Message-ID');
 530     chomp $msgid;
 531
 532     my ( $id, $msg ) = $transaction->Create(
 533         Ticket         => $self->TicketObj->Id,
 534         Type           => $type,
 535         Data           => $msgid,
 536         MIMEObj        => $MIMEObj,
 537         ActivateScrips => 0
 538     );
 539
 540     if ($id) {
 541         $self->{'OutgoingMailTransaction'} = $id;
 542     } else {
 543         $RT::Logger->warning(
 544             "Could not record outgoing message transaction: $msg");
 545     }
 546     return $id;
 547 }
 548
 549 =head2 SetRTSpecialHeaders
 550
 551 This routine adds all the random headers that RT wants in a mail message
 552 that don't matter much to anybody else.
 553
 554 =cut
 555
 556 sub SetRTSpecialHeaders {
 557     my $self = shift;
 558
 559     $self->SetSubject();
 560     $self->SetSubjectToken();
 561     $self->SetHeaderAsEncoding( 'Subject',
 562         RT->Config->Get('EmailOutputEncoding') )
 563         if ( RT->Config->Get('EmailOutputEncoding') );
 564     $self->SetReturnAddress();
 565     $self->SetReferencesHeaders();
 566
 567     unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
 568
 569         # Get Message-ID for this txn
 570         my $msgid = "";
 571         if ( my $msg = $self->TransactionObj->Message->First ) {
 572             $msgid = $msg->GetHeader("RT-Message-ID")
 573                 || $msg->GetHeader("Message-ID");
 574         }
 575
 576         # If there is one, and we can parse it, then base our Message-ID on it
 577         if (    $msgid
 578             and $msgid
 579             =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
 580                          "<$1." . $self->TicketObj->id
 581                           . "-" . $self->ScripObj->id
 582                           . "-" . $self->ScripActionObj->{_Message_ID}
 583                           . "@" . RT->Config->Get('Organization') . ">"/eg
 584             and $2 == $self->TicketObj->id
 585             )
 586         {
 587             $self->SetHeader( "Message-ID" => $msgid );
 588         } else {
 589             $self->SetHeader(
 590                 'Message-ID' => RT::Interface::Email::GenMessageId(
 591                     Ticket      => $self->TicketObj,
 592                     Scrip       => $self->ScripObj,
 593                     ScripAction => $self->ScripActionObj
 594                 ),
 595             );
 596         }
 597     }
 598
 599     if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
 600         and !$self->TemplateObj->MIMEObj->head->get("Precedence")
 601     ) {
 602         $self->SetHeader( 'Precedence', $precedence );
 603     }
 604
 605     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
 606     $self->SetHeader( 'RT-Ticket',
 607         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
 608     $self->SetHeader( 'Managed-by',
 609         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 610
 611 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 612 #            refactored into user's method.
 613     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
 614          and RT->Config->Get('UseOriginatorHeader')
 615     ) {
 616         $self->SetHeader( 'RT-Originator', $email );
 617     }
 618
 619 }
 620
 621
 622 sub DeferDigestRecipients {
 623     my $self = shift;
 624     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
 625
 626     # The digest attribute will be an array of notifications that need to
 627     # be sent for this transaction.  The array will have the following
 628     # format for its objects.
 629     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
 630     #                                     -> sent -> {true|false}
 631     # The "sent" flag will be used by the cron job to indicate that it has
 632     # run on this transaction.
 633     # In a perfect world we might move this hash construction to the
 634     # extension module itself.
 635     my $digest_hash = {};
 636
 637     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
 638         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
 639         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
 640         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
 641
 642         # Store the 'daily digest' folk in an array.
 643         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
 644
 645         # Have to get the list of addresses directly from the MIME header
 646         # at this point.
 647         $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
 648         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
 649             next unless $rcpt;
 650             my $user_obj = RT::User->new($RT::SystemUser);
 651             $user_obj->LoadByEmail($rcpt);
 652             if  ( ! $user_obj->id ) {
 653                 # If there's an email address in here without an associated
 654                 # RT user, pass it on through.
 655                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
 656                 push( @send_now, $rcpt );
 657                 next;
 658             }
 659
 660             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
 661             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
 662
 663             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
 664             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
 665             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
 666             else { push( @send_now, $rcpt ) }
 667         }
 668
 669         # Reset the relevant mail field.
 670         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
 671         if (@send_now) {
 672             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
 673         } else {    # No recipients!  Remove the header.
 674             $self->TemplateObj->MIMEObj->head->delete($mailfield);
 675         }
 676
 677         # Push the deferred addresses into the appropriate field in
 678         # our attribute hash, with the appropriate mail header.
 679         $RT::Logger->debug(
 680             "Setting deferred recipients for attribute creation");
 681         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
 682         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
 683         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
 684     }
 685
 686     if ( scalar keys %$digest_hash ) {
 687
 688         # Save the hash so that we can add it as an attribute to the
 689         # outgoing email transaction.
 690         $self->{'Deferred'} = $digest_hash;
 691     } else {
 692         $RT::Logger->debug( "No recipients found for deferred delivery on "
 693                 . "transaction #"
 694                 . $self->TransactionObj->id );
 695     }
 696 }
 697
 698
 699
 700 sub RecordDeferredRecipients {
 701     my $self = shift;
 702     return unless exists $self->{'Deferred'};
 703
 704     my $txn_id = $self->{'OutgoingMailTransaction'};
 705     return unless $txn_id;
 706
 707     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
 708     $txn_obj->Load( $txn_id );
 709     my( $ret, $msg ) = $txn_obj->AddAttribute(
 710         Name => 'DeferredRecipients',
 711         Content => $self->{'Deferred'}
 712     );
 713     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
 714         unless $ret;
 715
 716     return ($ret,$msg);
 717 }
 718
 719 =head2 SquelchMailTo [@ADDRESSES]
 720
 721 Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses.
 722 To empty list pass undefined argument.
 723
 724 B<Note> that this method can be called as class method and works globaly. Don't forget to
 725 clean this list when blocking is not required anymore, pass undef to do this.
 726
 727 =cut
 728
 729 {
 730     my $squelch = [];
 731
 732     sub SquelchMailTo {
 733         my $self = shift;
 734         if (@_) {
 735             $squelch = [ grep defined, @_ ];
 736         }
 737         return @$squelch;
 738     }
 739 }
 740
 741 =head2 RemoveInappropriateRecipients
 742
 743 Remove addresses that are RT addresses or that are on this transaction's blacklist
 744
 745 =cut
 746
 747 sub RemoveInappropriateRecipients {
 748     my $self = shift;
 749
 750     my @blacklist = ();
 751
 752     # If there are no recipients, don't try to send the message.
 753     # If the transaction has content and has the header RT-Squelch-Replies-To
 754
 755     my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
 756     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 757
 758         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
 759
 760             # What do we want to do with this? It's probably (?) a bounce
 761             # caused by one of the watcher addresses being broken.
 762             # Default ("true") is to redistribute, for historical reasons.
 763
 764             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
 765
 766                 # Don't send to any watchers.
 767                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
 768                 $RT::Logger->info( $msgid
 769                         . " The incoming message was autogenerated. "
 770                         . "Not redistributing this message based on site configuration."
 771                 );
 772             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
 773                 'privileged' )
 774             {
 775
 776                 # Only send to "privileged" watchers.
 777                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 778                     foreach my $addr ( @{ $self->{$type} } ) {
 779                         my $user = RT::User->new($RT::SystemUser);
 780                         $user->LoadByEmail($addr);
 781                         push @blacklist, $addr if ( !$user->Privileged );
 782                     }
 783                 }
 784                 $RT::Logger->info( $msgid
 785                         . " The incoming message was autogenerated. "
 786                         . "Not redistributing this message to unprivileged users based on site configuration."
 787                 );
 788             }
 789         }
 790
 791         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
 792             push @blacklist, split( /,/, $squelch );
 793         }
 794     }
 795
 796 # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
 797     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo;
 798     push @blacklist, $self->SquelchMailTo;
 799
 800     # Cycle through the people we're sending to and pull out anyone on the
 801     # system blacklist
 802
 803     # Trim leading and trailing spaces.
 804     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist));
 805
 806     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 807         my @addrs;
 808         foreach my $addr ( @{ $self->{$type} } ) {
 809
 810          # Weed out any RT addresses. We really don't want to talk to ourselves!
 811          # If we get a reply back, that means it's not an RT address
 812             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 813                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 814                 next;
 815             }
 816             if ( grep /^\Q$addr\E$/, @blacklist ) {
 817                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
 818                 next;
 819             }
 820             push @addrs, $addr;
 821         }
 822         @{ $self->{$type} } = @addrs;
 823     }
 824 }
 825
 826 =head2 SetReturnAddress is_comment => BOOLEAN
 827
 828 Calculate and set From and Reply-To headers based on the is_comment flag.
 829
 830 =cut
 831
 832 sub SetReturnAddress {
 833
 834     my $self = shift;
 835     my %args = (
 836         is_comment => 0,
 837         friendly_name => undef,
 838         @_
 839     );
 840
 841     # From and Reply-To
 842     # $args{is_comment} should be set if the comment address is to be used.
 843     my $replyto;
 844
 845     if ( $args{'is_comment'} ) {
 846         $replyto = $self->TicketObj->QueueObj->CommentAddress
 847             || RT->Config->Get('CommentAddress');
 848     } else {
 849         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 850             || RT->Config->Get('CorrespondAddress');
 851     }
 852
 853     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 854
 855         my $from = $replyto;
 856
 857         if ( RT->Config->Get('UseFriendlyFromLine') ) {
 858             my $friendly_name = $args{friendly_name};
 859
 860             unless ( $friendly_name ) {
 861                 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 862                 if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 863                     $friendly_name = $1;
 864                 }
 865             }
 866
 867             $friendly_name =~ s/"/\\"/g;
 868             $from =
 869                 sprintf(
 870                     RT->Config->Get('FriendlyFromLineFormat'),
 871                     $self->MIMEEncodeString(
 872                         $friendly_name, RT->Config->Get('EmailOutputEncoding')
 873                     ),
 874                     $replyto
 875                 );
 876         }
 877
 878         $self->SetHeader( 'From', $from );
 879
 880         #also set Sender:, otherwise MTAs add a nonsensical value like
 881         # rt@machine, and then Outlook prepends "rt@machine on behalf of" to
 882         # the From: header
 883         $self->SetHeader( 'Sender', $from );
 884     }
 885
 886     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 887         $self->SetHeader( 'Reply-To', "$replyto" );
 888     }
 889
 890 }
 891
 892 =head2 SetHeader FIELD, VALUE
 893
 894 Set the FIELD of the current MIME object into VALUE.
 895
 896 =cut
 897
 898 sub SetHeader {
 899     my $self  = shift;
 900     my $field = shift;
 901     my $val   = shift;
 902
 903     chomp $val;
 904     chomp $field;
 905     my $head = $self->TemplateObj->MIMEObj->head;
 906     $head->fold_length( $field, 10000 );
 907     $head->replace( $field, $val );
 908     return $head->get($field);
 909 }
 910
 911 =head2 SetSubject
 912
 913 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
 914 If subject is already defined via template, it uses that. otherwise, it tries to get
 915 the transaction's subject.
 916
 917 =cut
 918
 919 sub SetSubject {
 920     my $self = shift;
 921     my $subject;
 922
 923     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 924         return ();
 925     }
 926
 927     # don't use Transaction->Attachments because it caches
 928     # and anything which later calls ->Attachments will be hurt
 929     # by our RowsPerPage() call.  caching is hard.
 930     my $message = RT::Attachments->new( $self->CurrentUser );
 931     $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
 932     $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 933     $message->RowsPerPage(1);
 934
 935     if ( $self->{'Subject'} ) {
 936         $subject = $self->{'Subject'};
 937     } elsif ( my $first = $message->First ) {
 938         my $tmp = $first->GetHeader('Subject');
 939         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
 940     } else {
 941         $subject = $self->TicketObj->Subject;
 942     }
 943     $subject = '' unless defined $subject;
 944     chomp $subject;
 945
 946     $subject =~ s/(\r\n|\n|\s)/ /g;
 947
 948     $self->SetHeader( 'Subject', $subject );
 949
 950 }
 951
 952 =head2 SetSubjectToken
 953
 954 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 955
 956 =cut
 957
 958 sub SetSubjectToken {
 959     my $self = shift;
 960
 961     my $head = $self->TemplateObj->MIMEObj->head;
 962     $head->replace(
 963         Subject => RT::Interface::Email::AddSubjectTag(
 964             Encode::decode_utf8( $head->get('Subject') ),
 965             $self->TicketObj,
 966         ),
 967     );
 968 }
 969
 970 =head2 SetReferencesHeaders
 971
 972 Set References and In-Reply-To headers for this message.
 973
 974 =cut
 975
 976 sub SetReferencesHeaders {
 977     my $self = shift;
 978     my ( @in_reply_to, @references, @msgid );
 979
 980     if ( my $top = $self->TransactionObj->Message->First ) {
 981         @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
 982         @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
 983         @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
 984     } else {
 985         return (undef);
 986     }
 987
 988     # There are two main cases -- this transaction was created with
 989     # the RT Web UI, and hence we want to *not* append its Message-ID
 990     # to the References and In-Reply-To.  OR it came from an outside
 991     # source, and we should treat it as per the RFC
 992     my $org = RT->Config->Get('Organization');
 993     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
 994
 995         # Make all references which are internal be to version which we
 996         # have sent out
 997
 998         for ( @references, @in_reply_to ) {
 999             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1000           "<$1." . $self->TicketObj->id .
1001              "-" . $self->ScripObj->id .
1002              "-" . $self->ScripActionObj->{_Message_ID} .
1003              "@" . $org . ">"/eg
1004         }
1005
1006         # In reply to whatever the internal message was in reply to
1007         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1008
1009         # Default the references to whatever we're in reply to
1010         @references = @in_reply_to unless @references;
1011
1012         # References are unchanged from internal
1013     } else {
1014
1015         # In reply to that message
1016         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1017
1018         # Default the references to whatever we're in reply to
1019         @references = @in_reply_to unless @references;
1020
1021         # Push that message onto the end of the references
1022         push @references, @msgid;
1023     }
1024
1025     # Push pseudo-ref to the front
1026     my $pseudo_ref = $self->PseudoReference;
1027     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1028
1029     # If there are more than 10 references headers, remove all but the
1030     # first four and the last six (Gotta keep this from growing
1031     # forever)
1032     splice( @references, 4, -6 ) if ( $#references >= 10 );
1033
1034     # Add on the references
1035     $self->SetHeader( 'References', join( " ", @references ) );
1036     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1037
1038 }
1039
1040 =head2 PseudoReference
1041
1042 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1043
1044 =cut
1045
1046 sub PseudoReference {
1047
1048     my $self = shift;
1049     my $pseudo_ref
1050         = '<RT-Ticket-'
1051         . $self->TicketObj->id . '@'
1052         . RT->Config->Get('Organization') . '>';
1053     return $pseudo_ref;
1054 }
1055
1056 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1057
1058 This routine converts the field into specified charset encoding.
1059
1060 =cut
1061
1062 sub SetHeaderAsEncoding {
1063     my $self = shift;
1064     my ( $field, $enc ) = ( shift, shift );
1065
1066     my $head = $self->TemplateObj->MIMEObj->head;
1067
1068     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1069         $head->replace( $field, RT->Config->Get('SMTPFrom') );
1070         return;
1071     }
1072
1073     my $value = $head->get( $field );
1074     $value = $self->MIMEEncodeString( $value, $enc );
1075     $head->replace( $field, $value );
1076
1077 }
1078
1079 =head2 MIMEEncodeString
1080
1081 Takes a perl string and optional encoding pass it over
1082 L<RT::Interface::Email/EncodeToMIME>.
1083
1084 Basicly encode a string using B encoding according to RFC2047.
1085
1086 =cut
1087
1088 sub MIMEEncodeString {
1089     my $self  = shift;
1090     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1091 }
1092
1093 RT::Base->_ImportOverlays();
1094
1095 1;
1096