rt/lib/RT/Action/SendEmail.pm

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