rt/lib/RT/Action/SendEmail.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@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     $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
 104     my $message = $self->TemplateObj->MIMEObj;
 105
 106     my $orig_message;
 107     if (   RT->Config->Get('RecordOutgoingEmail')
 108         && RT->Config->Get('GnuPG')->{'Enable'} )
 109     {
 110
 111         # it's hacky, but we should know if we're going to crypt things
 112         my $attachment = $self->TransactionObj->Attachments->First;
 113
 114         my %crypt;
 115         foreach my $argument (qw(Sign Encrypt)) {
 116             if ( $attachment
 117                 && defined $attachment->GetHeader("X-RT-$argument") )
 118             {
 119                 $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
 120             } else {
 121                 $crypt{$argument} = $self->TicketObj->QueueObj->$argument();
 122             }
 123         }
 124         if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) {
 125             $orig_message = $message->dup;
 126         }
 127     }
 128
 129     my ($ret) = $self->SendMessage($message);
 130     if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) {
 131         if ($orig_message) {
 132             $message->attach(
 133                 Type        => 'application/x-rt-original-message',
 134                 Disposition => 'inline',
 135                 Data        => $orig_message->as_string,
 136             );
 137         }
 138         $self->RecordOutgoingMailTransaction($message);
 139         $self->RecordDeferredRecipients();
 140     }
 141
 142
 143     return ( abs $ret );
 144 }
 145
 146 =head2 Prepare
 147
 148 Builds an outgoing email we're going to send using scrip's template.
 149
 150 =cut
 151
 152 sub Prepare {
 153     my $self = shift;
 154
 155     my ( $result, $message ) = $self->TemplateObj->Parse(
 156         Argument       => $self->Argument,
 157         TicketObj      => $self->TicketObj,
 158         TransactionObj => $self->TransactionObj
 159     );
 160     if ( !$result ) {
 161         return (undef);
 162     }
 163
 164     my $MIMEObj = $self->TemplateObj->MIMEObj;
 165
 166     # Header
 167     $self->SetRTSpecialHeaders();
 168
 169     $self->RemoveInappropriateRecipients();
 170
 171     my %seen;
 172     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 173         @{ $self->{$type} }
 174             = grep defined && length && !$seen{ lc $_ }++,
 175             @{ $self->{$type} };
 176     }
 177
 178     # Go add all the Tos, Ccs and Bccs that we need to to the message to
 179     # make it happy, but only if we actually have values in those arrays.
 180
 181 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
 182
 183     for my $header (@EMAIL_RECIPIENT_HEADERS) {
 184
 185     $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
 186         if ( !$MIMEObj->head->get($header)
 187         && $self->{$header}
 188         && @{ $self->{$header} } );
 189 }
 190     # PseudoTo (fake to headers) shouldn't get matched for message recipients.
 191     # If we don't have any 'To' header (but do have other recipients), drop in
 192     # the pseudo-to header.
 193     $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
 194         if $self->{'PseudoTo'}
 195             && @{ $self->{'PseudoTo'} }
 196             && !$MIMEObj->head->get('To')
 197             && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
 198
 199     # We should never have to set the MIME-Version header
 200     $self->SetHeader( 'MIME-Version', '1.0' );
 201
 202     # fsck.com #5959: Since RT sends 8bit mail, we should say so.
 203     $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
 204
 205     # For security reasons, we only send out textual mails.
 206     foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
 207         my $type = $part->mime_type || 'text/plain';
 208         $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
 209         $part->head->mime_attr( "Content-Type"         => $type );
 210         $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 211     }
 212
 213     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
 214         RT->Config->Get('EmailOutputEncoding'),
 215         'mime_words_ok', );
 216
 217     # Build up a MIME::Entity that looks like the original message.
 218     $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
 219                                && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
 220
 221     $self->AddTickets;
 222
 223     my $attachment = $self->TransactionObj->Attachments->First;
 224     if ($attachment
 225         && !(
 226                $attachment->GetHeader('X-RT-Encrypt')
 227             || $self->TicketObj->QueueObj->Encrypt
 228         )
 229         )
 230     {
 231         $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
 232             if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
 233             'Success';
 234     }
 235
 236     return $result;
 237 }
 238
 239 =head2 To
 240
 241 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
 242
 243 =cut
 244
 245 sub To {
 246     my $self = shift;
 247     return ( $self->AddressesFromHeader('To') );
 248 }
 249
 250 =head2 Cc
 251
 252 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
 253
 254 =cut
 255
 256 sub Cc {
 257     my $self = shift;
 258     return ( $self->AddressesFromHeader('Cc') );
 259 }
 260
 261 =head2 Bcc
 262
 263 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
 264
 265 =cut
 266
 267 sub Bcc {
 268     my $self = shift;
 269     return ( $self->AddressesFromHeader('Bcc') );
 270
 271 }
 272
 273 sub AddressesFromHeader {
 274     my $self      = shift;
 275     my $field     = shift;
 276     my $header    = $self->TemplateObj->MIMEObj->head->get($field);
 277     my @addresses = Email::Address->parse($header);
 278
 279     return (@addresses);
 280 }
 281
 282 =head2 SendMessage MIMEObj
 283
 284 sends the message using RT's preferred API.
 285 TODO: Break this out to a separate module
 286
 287 =cut
 288
 289 sub SendMessage {
 290
 291     # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
 292     # ability to pass @_ to a 'post' routine.
 293     my ( $self, $MIMEObj ) = @_;
 294
 295     my $msgid = $MIMEObj->head->get('Message-ID');
 296     chomp $msgid;
 297
 298     $self->ScripActionObj->{_Message_ID}++;
 299
 300     $RT::Logger->info( $msgid . " #"
 301             . $self->TicketObj->id . "/"
 302             . $self->TransactionObj->id
 303             . " - Scrip "
 304             . ($self->ScripObj->id || '#rule'). " "
 305             . ( $self->ScripObj->Description || '' ) );
 306
 307     my $status = RT::Interface::Email::SendEmail(
 308         Entity      => $MIMEObj,
 309         Ticket      => $self->TicketObj,
 310         Transaction => $self->TransactionObj,
 311     );
 312
 313
 314     return $status unless ($status > 0 || exists $self->{'Deferred'});
 315
 316     my $success = $msgid . " sent ";
 317     foreach (@EMAIL_RECIPIENT_HEADERS) {
 318         my $recipients = $MIMEObj->head->get($_);
 319         $success .= " $_: " . $recipients if $recipients;
 320     }
 321
 322     if( exists $self->{'Deferred'} ) {
 323         for (qw(daily weekly susp)) {
 324             $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
 325                 if exists $self->{'Deferred'}{ $_ };
 326         }
 327     }
 328
 329     $success =~ s/\n//g;
 330
 331     $RT::Logger->info($success);
 332
 333     return (1);
 334 }
 335
 336 =head2 AddAttachments
 337
 338 Takes any attachments to this transaction and attaches them to the message
 339 we're building.
 340
 341 =cut
 342
 343 sub AddAttachments {
 344     my $self = shift;
 345
 346     my $MIMEObj = $self->TemplateObj->MIMEObj;
 347
 348     $MIMEObj->head->delete('RT-Attach-Message');
 349
 350     my $attachments = RT::Attachments->new($RT::SystemUser);
 351     $attachments->Limit(
 352         FIELD => 'TransactionId',
 353         VALUE => $self->TransactionObj->Id
 354     );
 355
 356     # Don't attach anything blank
 357     $attachments->LimitNotEmpty;
 358     $attachments->OrderBy( FIELD => 'id' );
 359
 360     # We want to make sure that we don't include the attachment that's
 361     # being used as the "Content" of this message" unless that attachment's
 362     # content type is not like text/...
 363     my $transaction_content_obj = $self->TransactionObj->ContentObj;
 364
 365     if (   $transaction_content_obj
 366         && $transaction_content_obj->ContentType =~ m{text/}i )
 367     {
 368         # If this was part of a multipart/alternative, skip all of the kids
 369         my $parent = $transaction_content_obj->ParentObj;
 370         if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
 371             $attachments->Limit(
 372                 ENTRYAGGREGATOR => 'AND',
 373                 FIELD           => 'parent',
 374                 OPERATOR        => '!=',
 375                 VALUE           => $parent->Id,
 376             );
 377         } else {
 378             $attachments->Limit(
 379                 ENTRYAGGREGATOR => 'AND',
 380                 FIELD           => 'id',
 381                 OPERATOR        => '!=',
 382                 VALUE           => $transaction_content_obj->Id,
 383             );
 384         }
 385     }
 386
 387     # attach any of this transaction's attachments
 388     my $seen_attachment = 0;
 389     while ( my $attach = $attachments->Next ) {
 390         if ( !$seen_attachment ) {
 391             $MIMEObj->make_multipart( 'mixed', Force => 1 );
 392             $seen_attachment = 1;
 393         }
 394         $self->AddAttachment($attach);
 395     }
 396 }
 397
 398 =head2 AddAttachment $attachment
 399
 400 Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
 401 we're building.
 402
 403 =cut
 404
 405 sub AddAttachment {
 406     my $self    = shift;
 407     my $attach  = shift;
 408     my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
 409
 410     $MIMEObj->attach(
 411         Type     => $attach->ContentType,
 412         Charset  => $attach->OriginalEncoding,
 413         Data     => $attach->OriginalContent,
 414         Filename => $self->MIMEEncodeString( $attach->Filename ),
 415         'RT-Attachment:' => $self->TicketObj->Id . "/"
 416             . $self->TransactionObj->Id . "/"
 417             . $attach->id,
 418         Encoding => '-SUGGEST',
 419     );
 420 }
 421
 422 =head2 AttachTickets [@IDs]
 423
 424 Returns or set list of ticket's IDs that should be attached to an outgoing message.
 425
 426 B<Note> this method works as a class method and setup things global, so you have to
 427 clean list by passing undef as argument.
 428
 429 =cut
 430
 431 {
 432     my $list = [];
 433
 434     sub AttachTickets {
 435         my $self = shift;
 436         $list = [ grep defined, @_ ] if @_;
 437         return @$list;
 438     }
 439 }
 440
 441 =head2 AddTickets
 442
 443 Attaches tickets to the current message, list of tickets' ids get from
 444 L</AttachTickets> method.
 445
 446 =cut
 447
 448 sub AddTickets {
 449     my $self = shift;
 450     $self->AddTicket($_) foreach $self->AttachTickets;
 451     return;
 452 }
 453
 454 =head2 AddTicket $ID
 455
 456 Attaches a ticket with ID to the message.
 457
 458 Each ticket is attached as multipart entity and all its messages and attachments
 459 are attached as sub entities in order of creation, but only if transaction type
 460 is Create or Correspond.
 461
 462 =cut
 463
 464 sub AddTicket {
 465     my $self = shift;
 466     my $tid  = shift;
 467
 468     # XXX: we need a current user here, but who is current user?
 469     my $attachs   = RT::Attachments->new($RT::SystemUser);
 470     my $txn_alias = $attachs->TransactionAlias;
 471     $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
 472     $attachs->Limit(
 473         ALIAS => $txn_alias,
 474         FIELD => 'Type',
 475         VALUE => 'Correspond'
 476     );
 477     $attachs->LimitByTicket($tid);
 478     $attachs->LimitNotEmpty;
 479     $attachs->OrderBy( FIELD => 'Created' );
 480
 481     my $ticket_mime = MIME::Entity->build(
 482         Type        => 'multipart/mixed',
 483         Top         => 0,
 484         Description => "ticket #$tid",
 485     );
 486     while ( my $attachment = $attachs->Next ) {
 487         $self->AddAttachment( $attachment, $ticket_mime );
 488     }
 489     if ( $ticket_mime->parts ) {
 490         my $email_mime = $self->TemplateObj->MIMEObj;
 491         $email_mime->make_multipart;
 492         $email_mime->add_part($ticket_mime);
 493     }
 494     return;
 495 }
 496
 497 =head2 RecordOutgoingMailTransaction MIMEObj
 498
 499 Record a transaction in RT with this outgoing message for future record-keeping purposes
 500
 501 =cut
 502
 503 sub RecordOutgoingMailTransaction {
 504     my $self    = shift;
 505     my $MIMEObj = shift;
 506
 507     my @parts = $MIMEObj->parts;
 508     my @attachments;
 509     my @keep;
 510     foreach my $part (@parts) {
 511         my $attach = $part->head->get('RT-Attachment');
 512         if ($attach) {
 513             $RT::Logger->debug(
 514                 "We found an attachment. we want to not record it.");
 515             push @attachments, $attach;
 516         } else {
 517             $RT::Logger->debug("We found a part. we want to record it.");
 518             push @keep, $part;
 519         }
 520     }
 521     $MIMEObj->parts( \@keep );
 522     foreach my $attachment (@attachments) {
 523         $MIMEObj->head->add( 'RT-Attachment', $attachment );
 524     }
 525
 526     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 527
 528     my $transaction
 529         = RT::Transaction->new( $self->TransactionObj->CurrentUser );
 530
 531 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 532
 533     my $type;
 534     if ( $self->TransactionObj->Type eq 'Comment' ) {
 535         $type = 'CommentEmailRecord';
 536     } else {
 537         $type = 'EmailRecord';
 538     }
 539
 540     my $msgid = $MIMEObj->head->get('Message-ID');
 541     chomp $msgid;
 542
 543     my ( $id, $msg ) = $transaction->Create(
 544         Ticket         => $self->TicketObj->Id,
 545         Type           => $type,
 546         Data           => $msgid,
 547         MIMEObj        => $MIMEObj,
 548         ActivateScrips => 0
 549     );
 550
 551     if ($id) {
 552         $self->{'OutgoingMailTransaction'} = $id;
 553     } else {
 554         $RT::Logger->warning(
 555             "Could not record outgoing message transaction: $msg");
 556     }
 557     return $id;
 558 }
 559
 560 =head2 SetRTSpecialHeaders
 561
 562 This routine adds all the random headers that RT wants in a mail message
 563 that don't matter much to anybody else.
 564
 565 =cut
 566
 567 sub SetRTSpecialHeaders {
 568     my $self = shift;
 569
 570     $self->SetSubject();
 571     $self->SetSubjectToken();
 572     $self->SetHeaderAsEncoding( 'Subject',
 573         RT->Config->Get('EmailOutputEncoding') )
 574         if ( RT->Config->Get('EmailOutputEncoding') );
 575     $self->SetReturnAddress();
 576     $self->SetReferencesHeaders();
 577
 578     unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
 579
 580         # Get Message-ID for this txn
 581         my $msgid = "";
 582         if ( my $msg = $self->TransactionObj->Message->First ) {
 583             $msgid = $msg->GetHeader("RT-Message-ID")
 584                 || $msg->GetHeader("Message-ID");
 585         }
 586
 587         # If there is one, and we can parse it, then base our Message-ID on it
 588         if (    $msgid
 589             and $msgid
 590             =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
 591                          "<$1." . $self->TicketObj->id
 592                           . "-" . $self->ScripObj->id
 593                           . "-" . $self->ScripActionObj->{_Message_ID}
 594                           . "@" . RT->Config->Get('Organization') . ">"/eg
 595             and $2 == $self->TicketObj->id
 596             )
 597         {
 598             $self->SetHeader( "Message-ID" => $msgid );
 599         } else {
 600             $self->SetHeader(
 601                 'Message-ID' => RT::Interface::Email::GenMessageId(
 602                     Ticket      => $self->TicketObj,
 603                     Scrip       => $self->ScripObj,
 604                     ScripAction => $self->ScripActionObj
 605                 ),
 606             );
 607         }
 608     }
 609
 610     $self->SetHeader( 'Precedence', "bulk" )
 611         unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") );
 612
 613     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
 614     $self->SetHeader( 'RT-Ticket',
 615         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
 616     $self->SetHeader( 'Managed-by',
 617         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 618
 619 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 620 #            refactored into user's method.
 621     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress ) {
 622         $self->SetHeader( 'RT-Originator', $email );
 623     }
 624
 625 }
 626
 627
 628 sub DeferDigestRecipients {
 629     my $self = shift;
 630     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
 631
 632     # The digest attribute will be an array of notifications that need to
 633     # be sent for this transaction.  The array will have the following
 634     # format for its objects.
 635     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
 636     #                                     -> sent -> {true|false}
 637     # The "sent" flag will be used by the cron job to indicate that it has
 638     # run on this transaction.
 639     # In a perfect world we might move this hash construction to the
 640     # extension module itself.
 641     my $digest_hash = {};
 642
 643     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
 644         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
 645         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
 646         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
 647
 648         # Store the 'daily digest' folk in an array.
 649         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
 650
 651         # Have to get the list of addresses directly from the MIME header
 652         # at this point.
 653         $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
 654         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
 655             next unless $rcpt;
 656             my $user_obj = RT::User->new($RT::SystemUser);
 657             $user_obj->LoadByEmail($rcpt);
 658             if  ( ! $user_obj->id ) {
 659                 # If there's an email address in here without an associated
 660                 # RT user, pass it on through.
 661                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
 662                 push( @send_now, $rcpt );
 663                 next;
 664             }
 665
 666             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
 667             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
 668
 669             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
 670             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
 671             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
 672             else { push( @send_now, $rcpt ) }
 673         }
 674
 675         # Reset the relevant mail field.
 676         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
 677         if (@send_now) {
 678             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
 679         } else {    # No recipients!  Remove the header.
 680             $self->TemplateObj->MIMEObj->head->delete($mailfield);
 681         }
 682
 683         # Push the deferred addresses into the appropriate field in
 684         # our attribute hash, with the appropriate mail header.
 685         $RT::Logger->debug(
 686             "Setting deferred recipients for attribute creation");
 687         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
 688         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
 689         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
 690     }
 691
 692     if ( scalar keys %$digest_hash ) {
 693
 694         # Save the hash so that we can add it as an attribute to the
 695         # outgoing email transaction.
 696         $self->{'Deferred'} = $digest_hash;
 697     } else {
 698         $RT::Logger->debug( "No recipients found for deferred delivery on "
 699                 . "transaction #"
 700                 . $self->TransactionObj->id );
 701     }
 702 }
 703
 704
 705
 706 sub RecordDeferredRecipients {
 707     my $self = shift;
 708     return unless exists $self->{'Deferred'};
 709
 710     my $txn_id = $self->{'OutgoingMailTransaction'};
 711     return unless $txn_id;
 712
 713     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
 714     $txn_obj->Load( $txn_id );
 715     my( $ret, $msg ) = $txn_obj->AddAttribute(
 716         Name => 'DeferredRecipients',
 717         Content => $self->{'Deferred'}
 718     );
 719     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
 720         unless $ret;
 721
 722     return ($ret,$msg);
 723 }
 724
 725 =head2 SquelchMailTo [@ADDRESSES]
 726
 727 Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses.
 728 To empty list pass undefined argument.
 729
 730 B<Note> that this method can be called as class method and works globaly. Don't forget to
 731 clean this list when blocking is not required anymore, pass undef to do this.
 732
 733 =cut
 734
 735 {
 736     my $squelch = [];
 737
 738     sub SquelchMailTo {
 739         my $self = shift;
 740         if (@_) {
 741             $squelch = [ grep defined, @_ ];
 742         }
 743         return @$squelch;
 744     }
 745 }
 746
 747 =head2 RemoveInappropriateRecipients
 748
 749 Remove addresses that are RT addresses or that are on this transaction's blacklist
 750
 751 =cut
 752
 753 sub RemoveInappropriateRecipients {
 754     my $self = shift;
 755
 756     my @blacklist = ();
 757
 758     # If there are no recipients, don't try to send the message.
 759     # If the transaction has content and has the header RT-Squelch-Replies-To
 760
 761     my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
 762     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 763
 764         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
 765
 766             # What do we want to do with this? It's probably (?) a bounce
 767             # caused by one of the watcher addresses being broken.
 768             # Default ("true") is to redistribute, for historical reasons.
 769
 770             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
 771
 772                 # Don't send to any watchers.
 773                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
 774                 $RT::Logger->info( $msgid
 775                         . " The incoming message was autogenerated. "
 776                         . "Not redistributing this message based on site configuration."
 777                 );
 778             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
 779                 'privileged' )
 780             {
 781
 782                 # Only send to "privileged" watchers.
 783                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 784                     foreach my $addr ( @{ $self->{$type} } ) {
 785                         my $user = RT::User->new($RT::SystemUser);
 786                         $user->LoadByEmail($addr);
 787                         push @blacklist, $addr if ( !$user->Privileged );
 788                     }
 789                 }
 790                 $RT::Logger->info( $msgid
 791                         . " The incoming message was autogenerated. "
 792                         . "Not redistributing this message to unprivileged users based on site configuration."
 793                 );
 794             }
 795         }
 796
 797         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
 798             push @blacklist, split( /,/, $squelch );
 799         }
 800     }
 801
 802 # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
 803     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo;
 804     push @blacklist, $self->SquelchMailTo;
 805
 806     # Cycle through the people we're sending to and pull out anyone on the
 807     # system blacklist
 808
 809     # Trim leading and trailing spaces.
 810     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist));
 811
 812     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 813         my @addrs;
 814         foreach my $addr ( @{ $self->{$type} } ) {
 815
 816          # Weed out any RT addresses. We really don't want to talk to ourselves!
 817          # If we get a reply back, that means it's not an RT address
 818             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 819                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 820                 next;
 821             }
 822             if ( grep /^\Q$addr\E$/, @blacklist ) {
 823                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
 824                 next;
 825             }
 826             push @addrs, $addr;
 827         }
 828         @{ $self->{$type} } = @addrs;
 829     }
 830 }
 831
 832 =head2 SetReturnAddress is_comment => BOOLEAN
 833
 834 Calculate and set From and Reply-To headers based on the is_comment flag.
 835
 836 =cut
 837
 838 sub SetReturnAddress {
 839
 840     my $self = shift;
 841     my %args = (
 842         is_comment => 0,
 843         friendly_name => undef,
 844         @_
 845     );
 846
 847     # From and Reply-To
 848     # $args{is_comment} should be set if the comment address is to be used.
 849     my $replyto;
 850
 851     if ( $args{'is_comment'} ) {
 852         $replyto = $self->TicketObj->QueueObj->CommentAddress
 853             || RT->Config->Get('CommentAddress');
 854     } else {
 855         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 856             || RT->Config->Get('CorrespondAddress');
 857     }
 858
 859     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 860         if ( RT->Config->Get('UseFriendlyFromLine') ) {
 861             my $friendly_name = $args{friendly_name};
 862
 863             unless ( $friendly_name ) {
 864                 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 865                 if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 866                     $friendly_name = $1;
 867                 }
 868             }
 869
 870             $friendly_name =~ s/"/\\"/g;
 871             $self->SetHeader(
 872                 'From',
 873                 sprintf(
 874                     RT->Config->Get('FriendlyFromLineFormat'),
 875                     $self->MIMEEncodeString(
 876                         $friendly_name, RT->Config->Get('EmailOutputEncoding')
 877                     ),
 878                     $replyto
 879                 ),
 880             );
 881         } else {
 882             $self->SetHeader( 'From', $replyto );
 883         }
 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     my $message = $self->TransactionObj->Attachments;
 928     $message->RowsPerPage(1);
 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 eval "require RT::Action::SendEmail_Vendor";
1088 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm} );
1089 eval "require RT::Action::SendEmail_Local";
1090 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm} );
1091
1092 1;
1093