rt/lib/RT/Action/SendEmail.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 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         if ( RT->Config->Get('UseFriendlyFromLine') ) {
 855             my $friendly_name = $args{friendly_name};
 856
 857             unless ( $friendly_name ) {
 858                 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 859                 if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 860                     $friendly_name = $1;
 861                 }
 862             }
 863
 864             $friendly_name =~ s/"/\\"/g;
 865             $self->SetHeader(
 866                 'From',
 867                 sprintf(
 868                     RT->Config->Get('FriendlyFromLineFormat'),
 869                     $self->MIMEEncodeString(
 870                         $friendly_name, RT->Config->Get('EmailOutputEncoding')
 871                     ),
 872                     $replyto
 873                 ),
 874             );
 875         } else {
 876             $self->SetHeader( 'From', $replyto );
 877         }
 878     }
 879
 880     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 881         $self->SetHeader( 'Reply-To', "$replyto" );
 882     }
 883
 884 }
 885
 886 =head2 SetHeader FIELD, VALUE
 887
 888 Set the FIELD of the current MIME object into VALUE.
 889
 890 =cut
 891
 892 sub SetHeader {
 893     my $self  = shift;
 894     my $field = shift;
 895     my $val   = shift;
 896
 897     chomp $val;
 898     chomp $field;
 899     my $head = $self->TemplateObj->MIMEObj->head;
 900     $head->fold_length( $field, 10000 );
 901     $head->replace( $field, $val );
 902     return $head->get($field);
 903 }
 904
 905 =head2 SetSubject
 906
 907 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
 908 If subject is already defined via template, it uses that. otherwise, it tries to get
 909 the transaction's subject.
 910
 911 =cut
 912
 913 sub SetSubject {
 914     my $self = shift;
 915     my $subject;
 916
 917     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 918         return ();
 919     }
 920
 921     # don't use Transaction->Attachments because it caches
 922     # and anything which later calls ->Attachments will be hurt
 923     # by our RowsPerPage() call.  caching is hard.
 924     my $message = RT::Attachments->new( $self->CurrentUser );
 925     $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
 926     $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 927     $message->RowsPerPage(1);
 928
 929     if ( $self->{'Subject'} ) {
 930         $subject = $self->{'Subject'};
 931     } elsif ( my $first = $message->First ) {
 932         my $tmp = $first->GetHeader('Subject');
 933         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
 934     } else {
 935         $subject = $self->TicketObj->Subject;
 936     }
 937     $subject = '' unless defined $subject;
 938     chomp $subject;
 939
 940     $subject =~ s/(\r\n|\n|\s)/ /g;
 941
 942     $self->SetHeader( 'Subject', $subject );
 943
 944 }
 945
 946 =head2 SetSubjectToken
 947
 948 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 949
 950 =cut
 951
 952 sub SetSubjectToken {
 953     my $self = shift;
 954
 955     my $head = $self->TemplateObj->MIMEObj->head;
 956     $head->replace(
 957         Subject => RT::Interface::Email::AddSubjectTag(
 958             Encode::decode_utf8( $head->get('Subject') ),
 959             $self->TicketObj,
 960         ),
 961     );
 962 }
 963
 964 =head2 SetReferencesHeaders
 965
 966 Set References and In-Reply-To headers for this message.
 967
 968 =cut
 969
 970 sub SetReferencesHeaders {
 971     my $self = shift;
 972     my ( @in_reply_to, @references, @msgid );
 973
 974     if ( my $top = $self->TransactionObj->Message->First ) {
 975         @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
 976         @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
 977         @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
 978     } else {
 979         return (undef);
 980     }
 981
 982     # There are two main cases -- this transaction was created with
 983     # the RT Web UI, and hence we want to *not* append its Message-ID
 984     # to the References and In-Reply-To.  OR it came from an outside
 985     # source, and we should treat it as per the RFC
 986     my $org = RT->Config->Get('Organization');
 987     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
 988
 989         # Make all references which are internal be to version which we
 990         # have sent out
 991
 992         for ( @references, @in_reply_to ) {
 993             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
 994           "<$1." . $self->TicketObj->id .
 995              "-" . $self->ScripObj->id .
 996              "-" . $self->ScripActionObj->{_Message_ID} .
 997              "@" . $org . ">"/eg
 998         }
 999
1000         # In reply to whatever the internal message was in reply to
1001         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1002
1003         # Default the references to whatever we're in reply to
1004         @references = @in_reply_to unless @references;
1005
1006         # References are unchanged from internal
1007     } else {
1008
1009         # In reply to that message
1010         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1011
1012         # Default the references to whatever we're in reply to
1013         @references = @in_reply_to unless @references;
1014
1015         # Push that message onto the end of the references
1016         push @references, @msgid;
1017     }
1018
1019     # Push pseudo-ref to the front
1020     my $pseudo_ref = $self->PseudoReference;
1021     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1022
1023     # If there are more than 10 references headers, remove all but the
1024     # first four and the last six (Gotta keep this from growing
1025     # forever)
1026     splice( @references, 4, -6 ) if ( $#references >= 10 );
1027
1028     # Add on the references
1029     $self->SetHeader( 'References', join( " ", @references ) );
1030     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1031
1032 }
1033
1034 =head2 PseudoReference
1035
1036 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1037
1038 =cut
1039
1040 sub PseudoReference {
1041
1042     my $self = shift;
1043     my $pseudo_ref
1044         = '<RT-Ticket-'
1045         . $self->TicketObj->id . '@'
1046         . RT->Config->Get('Organization') . '>';
1047     return $pseudo_ref;
1048 }
1049
1050 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1051
1052 This routine converts the field into specified charset encoding.
1053
1054 =cut
1055
1056 sub SetHeaderAsEncoding {
1057     my $self = shift;
1058     my ( $field, $enc ) = ( shift, shift );
1059
1060     my $head = $self->TemplateObj->MIMEObj->head;
1061
1062     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1063         $head->replace( $field, RT->Config->Get('SMTPFrom') );
1064         return;
1065     }
1066
1067     my $value = $head->get( $field );
1068     $value = $self->MIMEEncodeString( $value, $enc );
1069     $head->replace( $field, $value );
1070
1071 }
1072
1073 =head2 MIMEEncodeString
1074
1075 Takes a perl string and optional encoding pass it over
1076 L<RT::Interface::Email/EncodeToMIME>.
1077
1078 Basicly encode a string using B encoding according to RFC2047.
1079
1080 =cut
1081
1082 sub MIMEEncodeString {
1083     my $self  = shift;
1084     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1085 }
1086
1087 RT::Base->_ImportOverlays();
1088
1089 1;
1090