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     if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
 611         and !$self->TemplateObj->MIMEObj->head->get("Precedence")
 612     ) {
 613         $self->SetHeader( 'Precedence', $precedence );
 614     }
 615
 616     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
 617     $self->SetHeader( 'RT-Ticket',
 618         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
 619     $self->SetHeader( 'Managed-by',
 620         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 621
 622 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 623 #            refactored into user's method.
 624     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
 625          and RT->Config->Get('UseOriginatorHeader')
 626     ) {
 627         $self->SetHeader( 'RT-Originator', $email );
 628     }
 629
 630 }
 631
 632
 633 sub DeferDigestRecipients {
 634     my $self = shift;
 635     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
 636
 637     # The digest attribute will be an array of notifications that need to
 638     # be sent for this transaction.  The array will have the following
 639     # format for its objects.
 640     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
 641     #                                     -> sent -> {true|false}
 642     # The "sent" flag will be used by the cron job to indicate that it has
 643     # run on this transaction.
 644     # In a perfect world we might move this hash construction to the
 645     # extension module itself.
 646     my $digest_hash = {};
 647
 648     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
 649         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
 650         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
 651         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
 652
 653         # Store the 'daily digest' folk in an array.
 654         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
 655
 656         # Have to get the list of addresses directly from the MIME header
 657         # at this point.
 658         $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
 659         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
 660             next unless $rcpt;
 661             my $user_obj = RT::User->new($RT::SystemUser);
 662             $user_obj->LoadByEmail($rcpt);
 663             if  ( ! $user_obj->id ) {
 664                 # If there's an email address in here without an associated
 665                 # RT user, pass it on through.
 666                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
 667                 push( @send_now, $rcpt );
 668                 next;
 669             }
 670
 671             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
 672             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
 673
 674             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
 675             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
 676             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
 677             else { push( @send_now, $rcpt ) }
 678         }
 679
 680         # Reset the relevant mail field.
 681         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
 682         if (@send_now) {
 683             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
 684         } else {    # No recipients!  Remove the header.
 685             $self->TemplateObj->MIMEObj->head->delete($mailfield);
 686         }
 687
 688         # Push the deferred addresses into the appropriate field in
 689         # our attribute hash, with the appropriate mail header.
 690         $RT::Logger->debug(
 691             "Setting deferred recipients for attribute creation");
 692         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
 693         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
 694         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
 695     }
 696
 697     if ( scalar keys %$digest_hash ) {
 698
 699         # Save the hash so that we can add it as an attribute to the
 700         # outgoing email transaction.
 701         $self->{'Deferred'} = $digest_hash;
 702     } else {
 703         $RT::Logger->debug( "No recipients found for deferred delivery on "
 704                 . "transaction #"
 705                 . $self->TransactionObj->id );
 706     }
 707 }
 708
 709
 710
 711 sub RecordDeferredRecipients {
 712     my $self = shift;
 713     return unless exists $self->{'Deferred'};
 714
 715     my $txn_id = $self->{'OutgoingMailTransaction'};
 716     return unless $txn_id;
 717
 718     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
 719     $txn_obj->Load( $txn_id );
 720     my( $ret, $msg ) = $txn_obj->AddAttribute(
 721         Name => 'DeferredRecipients',
 722         Content => $self->{'Deferred'}
 723     );
 724     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
 725         unless $ret;
 726
 727     return ($ret,$msg);
 728 }
 729
 730 =head2 SquelchMailTo [@ADDRESSES]
 731
 732 Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses.
 733 To empty list pass undefined argument.
 734
 735 B<Note> that this method can be called as class method and works globaly. Don't forget to
 736 clean this list when blocking is not required anymore, pass undef to do this.
 737
 738 =cut
 739
 740 {
 741     my $squelch = [];
 742
 743     sub SquelchMailTo {
 744         my $self = shift;
 745         if (@_) {
 746             $squelch = [ grep defined, @_ ];
 747         }
 748         return @$squelch;
 749     }
 750 }
 751
 752 =head2 RemoveInappropriateRecipients
 753
 754 Remove addresses that are RT addresses or that are on this transaction's blacklist
 755
 756 =cut
 757
 758 sub RemoveInappropriateRecipients {
 759     my $self = shift;
 760
 761     my @blacklist = ();
 762
 763     # If there are no recipients, don't try to send the message.
 764     # If the transaction has content and has the header RT-Squelch-Replies-To
 765
 766     my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
 767     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 768
 769         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
 770
 771             # What do we want to do with this? It's probably (?) a bounce
 772             # caused by one of the watcher addresses being broken.
 773             # Default ("true") is to redistribute, for historical reasons.
 774
 775             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
 776
 777                 # Don't send to any watchers.
 778                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
 779                 $RT::Logger->info( $msgid
 780                         . " The incoming message was autogenerated. "
 781                         . "Not redistributing this message based on site configuration."
 782                 );
 783             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
 784                 'privileged' )
 785             {
 786
 787                 # Only send to "privileged" watchers.
 788                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 789                     foreach my $addr ( @{ $self->{$type} } ) {
 790                         my $user = RT::User->new($RT::SystemUser);
 791                         $user->LoadByEmail($addr);
 792                         push @blacklist, $addr if ( !$user->Privileged );
 793                     }
 794                 }
 795                 $RT::Logger->info( $msgid
 796                         . " The incoming message was autogenerated. "
 797                         . "Not redistributing this message to unprivileged users based on site configuration."
 798                 );
 799             }
 800         }
 801
 802         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
 803             push @blacklist, split( /,/, $squelch );
 804         }
 805     }
 806
 807 # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
 808     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo;
 809     push @blacklist, $self->SquelchMailTo;
 810
 811     # Cycle through the people we're sending to and pull out anyone on the
 812     # system blacklist
 813
 814     # Trim leading and trailing spaces.
 815     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist));
 816
 817     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 818         my @addrs;
 819         foreach my $addr ( @{ $self->{$type} } ) {
 820
 821          # Weed out any RT addresses. We really don't want to talk to ourselves!
 822          # If we get a reply back, that means it's not an RT address
 823             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 824                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 825                 next;
 826             }
 827             if ( grep /^\Q$addr\E$/, @blacklist ) {
 828                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
 829                 next;
 830             }
 831             push @addrs, $addr;
 832         }
 833         @{ $self->{$type} } = @addrs;
 834     }
 835 }
 836
 837 =head2 SetReturnAddress is_comment => BOOLEAN
 838
 839 Calculate and set From and Reply-To headers based on the is_comment flag.
 840
 841 =cut
 842
 843 sub SetReturnAddress {
 844
 845     my $self = shift;
 846     my %args = (
 847         is_comment => 0,
 848         friendly_name => undef,
 849         @_
 850     );
 851
 852     # From and Reply-To
 853     # $args{is_comment} should be set if the comment address is to be used.
 854     my $replyto;
 855
 856     if ( $args{'is_comment'} ) {
 857         $replyto = $self->TicketObj->QueueObj->CommentAddress
 858             || RT->Config->Get('CommentAddress');
 859     } else {
 860         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 861             || RT->Config->Get('CorrespondAddress');
 862     }
 863
 864     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 865         if ( RT->Config->Get('UseFriendlyFromLine') ) {
 866             my $friendly_name = $args{friendly_name};
 867
 868             unless ( $friendly_name ) {
 869                 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 870                 if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 871                     $friendly_name = $1;
 872                 }
 873             }
 874
 875             $friendly_name =~ s/"/\\"/g;
 876             $self->SetHeader(
 877                 'From',
 878                 sprintf(
 879                     RT->Config->Get('FriendlyFromLineFormat'),
 880                     $self->MIMEEncodeString(
 881                         $friendly_name, RT->Config->Get('EmailOutputEncoding')
 882                     ),
 883                     $replyto
 884                 ),
 885             );
 886         } else {
 887             $self->SetHeader( 'From', $replyto );
 888         }
 889     }
 890
 891     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 892         $self->SetHeader( 'Reply-To', "$replyto" );
 893     }
 894
 895 }
 896
 897 =head2 SetHeader FIELD, VALUE
 898
 899 Set the FIELD of the current MIME object into VALUE.
 900
 901 =cut
 902
 903 sub SetHeader {
 904     my $self  = shift;
 905     my $field = shift;
 906     my $val   = shift;
 907
 908     chomp $val;
 909     chomp $field;
 910     my $head = $self->TemplateObj->MIMEObj->head;
 911     $head->fold_length( $field, 10000 );
 912     $head->replace( $field, $val );
 913     return $head->get($field);
 914 }
 915
 916 =head2 SetSubject
 917
 918 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
 919 If subject is already defined via template, it uses that. otherwise, it tries to get
 920 the transaction's subject.
 921
 922 =cut
 923
 924 sub SetSubject {
 925     my $self = shift;
 926     my $subject;
 927
 928     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 929         return ();
 930     }
 931
 932     my $message = $self->TransactionObj->Attachments;
 933     $message->RowsPerPage(1);
 934     if ( $self->{'Subject'} ) {
 935         $subject = $self->{'Subject'};
 936     } elsif ( my $first = $message->First ) {
 937         my $tmp = $first->GetHeader('Subject');
 938         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
 939     } else {
 940         $subject = $self->TicketObj->Subject;
 941     }
 942     $subject = '' unless defined $subject;
 943     chomp $subject;
 944
 945     $subject =~ s/(\r\n|\n|\s)/ /g;
 946
 947     $self->SetHeader( 'Subject', $subject );
 948
 949 }
 950
 951 =head2 SetSubjectToken
 952
 953 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 954
 955 =cut
 956
 957 sub SetSubjectToken {
 958     my $self = shift;
 959
 960     my $head = $self->TemplateObj->MIMEObj->head;
 961     $head->replace(
 962         Subject => RT::Interface::Email::AddSubjectTag(
 963             Encode::decode_utf8( $head->get('Subject') ),
 964             $self->TicketObj,
 965         ),
 966     );
 967 }
 968
 969 =head2 SetReferencesHeaders
 970
 971 Set References and In-Reply-To headers for this message.
 972
 973 =cut
 974
 975 sub SetReferencesHeaders {
 976     my $self = shift;
 977     my ( @in_reply_to, @references, @msgid );
 978
 979     if ( my $top = $self->TransactionObj->Message->First ) {
 980         @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
 981         @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
 982         @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
 983     } else {
 984         return (undef);
 985     }
 986
 987     # There are two main cases -- this transaction was created with
 988     # the RT Web UI, and hence we want to *not* append its Message-ID
 989     # to the References and In-Reply-To.  OR it came from an outside
 990     # source, and we should treat it as per the RFC
 991     my $org = RT->Config->Get('Organization');
 992     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
 993
 994         # Make all references which are internal be to version which we
 995         # have sent out
 996
 997         for ( @references, @in_reply_to ) {
 998             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
 999           "<$1." . $self->TicketObj->id .
1000              "-" . $self->ScripObj->id .
1001              "-" . $self->ScripActionObj->{_Message_ID} .
1002              "@" . $org . ">"/eg
1003         }
1004
1005         # In reply to whatever the internal message was in reply to
1006         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1007
1008         # Default the references to whatever we're in reply to
1009         @references = @in_reply_to unless @references;
1010
1011         # References are unchanged from internal
1012     } else {
1013
1014         # In reply to that message
1015         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1016
1017         # Default the references to whatever we're in reply to
1018         @references = @in_reply_to unless @references;
1019
1020         # Push that message onto the end of the references
1021         push @references, @msgid;
1022     }
1023
1024     # Push pseudo-ref to the front
1025     my $pseudo_ref = $self->PseudoReference;
1026     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1027
1028     # If there are more than 10 references headers, remove all but the
1029     # first four and the last six (Gotta keep this from growing
1030     # forever)
1031     splice( @references, 4, -6 ) if ( $#references >= 10 );
1032
1033     # Add on the references
1034     $self->SetHeader( 'References', join( " ", @references ) );
1035     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1036
1037 }
1038
1039 =head2 PseudoReference
1040
1041 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1042
1043 =cut
1044
1045 sub PseudoReference {
1046
1047     my $self = shift;
1048     my $pseudo_ref
1049         = '<RT-Ticket-'
1050         . $self->TicketObj->id . '@'
1051         . RT->Config->Get('Organization') . '>';
1052     return $pseudo_ref;
1053 }
1054
1055 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1056
1057 This routine converts the field into specified charset encoding.
1058
1059 =cut
1060
1061 sub SetHeaderAsEncoding {
1062     my $self = shift;
1063     my ( $field, $enc ) = ( shift, shift );
1064
1065     my $head = $self->TemplateObj->MIMEObj->head;
1066
1067     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1068         $head->replace( $field, RT->Config->Get('SMTPFrom') );
1069         return;
1070     }
1071
1072     my $value = $head->get( $field );
1073     $value = $self->MIMEEncodeString( $value, $enc );
1074     $head->replace( $field, $value );
1075
1076 }
1077
1078 =head2 MIMEEncodeString
1079
1080 Takes a perl string and optional encoding pass it over
1081 L<RT::Interface::Email/EncodeToMIME>.
1082
1083 Basicly encode a string using B encoding according to RFC2047.
1084
1085 =cut
1086
1087 sub MIMEEncodeString {
1088     my $self  = shift;
1089     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1090 }
1091
1092 eval "require RT::Action::SendEmail_Vendor";
1093 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm} );
1094 eval "require RT::Action::SendEmail_Local";
1095 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm} );
1096
1097 1;
1098