rt/lib/RT/Action/SendEmail.pm

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