rt/lib/RT/Action/SendEmail.pm

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