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->TransactionObj may not always be $self->TransactionObj
 412     return unless $attach->Id
 413               and $attach->TransactionObj->CurrentUserCanSee;
 414
 415     # ->attach expects just the disposition type; extract it if we have the header
 416     my $disp = ($attach->GetHeader('Content-Disposition') || '')
 417                     =~ /^\s*(inline|attachment)/i ? $1 : undef;
 418
 419     $MIMEObj->attach(
 420         Type        => $attach->ContentType,
 421         Charset     => $attach->OriginalEncoding,
 422         Data        => $attach->OriginalContent,
 423         Disposition => $disp, # a false value defaults to inline in MIME::Entity
 424         Filename    => $self->MIMEEncodeString( $attach->Filename ),
 425         'RT-Attachment:' => $self->TicketObj->Id . "/"
 426             . $self->TransactionObj->Id . "/"
 427             . $attach->id,
 428         Encoding => '-SUGGEST',
 429     );
 430 }
 431
 432 =head2 AttachTickets [@IDs]
 433
 434 Returns or set list of ticket's IDs that should be attached to an outgoing message.
 435
 436 B<Note> this method works as a class method and setup things global, so you have to
 437 clean list by passing undef as argument.
 438
 439 =cut
 440
 441 {
 442     my $list = [];
 443
 444     sub AttachTickets {
 445         my $self = shift;
 446         $list = [ grep defined, @_ ] if @_;
 447         return @$list;
 448     }
 449 }
 450
 451 =head2 AddTickets
 452
 453 Attaches tickets to the current message, list of tickets' ids get from
 454 L</AttachTickets> method.
 455
 456 =cut
 457
 458 sub AddTickets {
 459     my $self = shift;
 460     $self->AddTicket($_) foreach $self->AttachTickets;
 461     return;
 462 }
 463
 464 =head2 AddTicket $ID
 465
 466 Attaches a ticket with ID to the message.
 467
 468 Each ticket is attached as multipart entity and all its messages and attachments
 469 are attached as sub entities in order of creation, but only if transaction type
 470 is Create or Correspond.
 471
 472 =cut
 473
 474 sub AddTicket {
 475     my $self = shift;
 476     my $tid  = shift;
 477
 478     my $attachs   = RT::Attachments->new( $self->TransactionObj->CreatorObj );
 479     my $txn_alias = $attachs->TransactionAlias;
 480     $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
 481     $attachs->Limit(
 482         ALIAS => $txn_alias,
 483         FIELD => 'Type',
 484         VALUE => 'Correspond'
 485     );
 486     $attachs->LimitByTicket($tid);
 487     $attachs->LimitNotEmpty;
 488     $attachs->OrderBy( FIELD => 'Created' );
 489
 490     my $ticket_mime = MIME::Entity->build(
 491         Type        => 'multipart/mixed',
 492         Top         => 0,
 493         Description => "ticket #$tid",
 494     );
 495     while ( my $attachment = $attachs->Next ) {
 496         $self->AddAttachment( $attachment, $ticket_mime );
 497     }
 498     if ( $ticket_mime->parts ) {
 499         my $email_mime = $self->TemplateObj->MIMEObj;
 500         $email_mime->make_multipart;
 501         $email_mime->add_part($ticket_mime);
 502     }
 503     return;
 504 }
 505
 506 =head2 RecordOutgoingMailTransaction MIMEObj
 507
 508 Record a transaction in RT with this outgoing message for future record-keeping purposes
 509
 510 =cut
 511
 512 sub RecordOutgoingMailTransaction {
 513     my $self    = shift;
 514     my $MIMEObj = shift;
 515
 516     my @parts = $MIMEObj->parts;
 517     my @attachments;
 518     my @keep;
 519     foreach my $part (@parts) {
 520         my $attach = $part->head->get('RT-Attachment');
 521         if ($attach) {
 522             $RT::Logger->debug(
 523                 "We found an attachment. we want to not record it.");
 524             push @attachments, $attach;
 525         } else {
 526             $RT::Logger->debug("We found a part. we want to record it.");
 527             push @keep, $part;
 528         }
 529     }
 530     $MIMEObj->parts( \@keep );
 531     foreach my $attachment (@attachments) {
 532         $MIMEObj->head->add( 'RT-Attachment', $attachment );
 533     }
 534
 535     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 536
 537     my $transaction
 538         = RT::Transaction->new( $self->TransactionObj->CurrentUser );
 539
 540 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 541
 542     my $type;
 543     if ( $self->TransactionObj->Type eq 'Comment' ) {
 544         $type = 'CommentEmailRecord';
 545     } else {
 546         $type = 'EmailRecord';
 547     }
 548
 549     my $msgid = $MIMEObj->head->get('Message-ID');
 550     chomp $msgid;
 551
 552     my ( $id, $msg ) = $transaction->Create(
 553         Ticket         => $self->TicketObj->Id,
 554         Type           => $type,
 555         Data           => $msgid,
 556         MIMEObj        => $MIMEObj,
 557         ActivateScrips => 0
 558     );
 559
 560     if ($id) {
 561         $self->{'OutgoingMailTransaction'} = $id;
 562     } else {
 563         $RT::Logger->warning(
 564             "Could not record outgoing message transaction: $msg");
 565     }
 566     return $id;
 567 }
 568
 569 =head2 SetRTSpecialHeaders
 570
 571 This routine adds all the random headers that RT wants in a mail message
 572 that don't matter much to anybody else.
 573
 574 =cut
 575
 576 sub SetRTSpecialHeaders {
 577     my $self = shift;
 578
 579     $self->SetSubject();
 580     $self->SetSubjectToken();
 581     $self->SetHeaderAsEncoding( 'Subject',
 582         RT->Config->Get('EmailOutputEncoding') )
 583         if ( RT->Config->Get('EmailOutputEncoding') );
 584     $self->SetReturnAddress();
 585     $self->SetReferencesHeaders();
 586
 587     unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
 588
 589         # Get Message-ID for this txn
 590         my $msgid = "";
 591         if ( my $msg = $self->TransactionObj->Message->First ) {
 592             $msgid = $msg->GetHeader("RT-Message-ID")
 593                 || $msg->GetHeader("Message-ID");
 594         }
 595
 596         # If there is one, and we can parse it, then base our Message-ID on it
 597         if (    $msgid
 598             and $msgid
 599             =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
 600                          "<$1." . $self->TicketObj->id
 601                           . "-" . $self->ScripObj->id
 602                           . "-" . $self->ScripActionObj->{_Message_ID}
 603                           . "@" . RT->Config->Get('Organization') . ">"/eg
 604             and $2 == $self->TicketObj->id
 605             )
 606         {
 607             $self->SetHeader( "Message-ID" => $msgid );
 608         } else {
 609             $self->SetHeader(
 610                 'Message-ID' => RT::Interface::Email::GenMessageId(
 611                     Ticket      => $self->TicketObj,
 612                     Scrip       => $self->ScripObj,
 613                     ScripAction => $self->ScripActionObj
 614                 ),
 615             );
 616         }
 617     }
 618
 619     if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
 620         and !$self->TemplateObj->MIMEObj->head->get("Precedence")
 621     ) {
 622         $self->SetHeader( 'Precedence', $precedence );
 623     }
 624
 625     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
 626     $self->SetHeader( 'RT-Ticket',
 627         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
 628     $self->SetHeader( 'Managed-by',
 629         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 630
 631 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 632 #            refactored into user's method.
 633     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
 634          and RT->Config->Get('UseOriginatorHeader')
 635     ) {
 636         $self->SetHeader( 'RT-Originator', $email );
 637     }
 638
 639 }
 640
 641
 642 sub DeferDigestRecipients {
 643     my $self = shift;
 644     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
 645
 646     # The digest attribute will be an array of notifications that need to
 647     # be sent for this transaction.  The array will have the following
 648     # format for its objects.
 649     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
 650     #                                     -> sent -> {true|false}
 651     # The "sent" flag will be used by the cron job to indicate that it has
 652     # run on this transaction.
 653     # In a perfect world we might move this hash construction to the
 654     # extension module itself.
 655     my $digest_hash = {};
 656
 657     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
 658         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
 659         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
 660         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
 661
 662         # Store the 'daily digest' folk in an array.
 663         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
 664
 665         # Have to get the list of addresses directly from the MIME header
 666         # at this point.
 667         $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
 668         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
 669             next unless $rcpt;
 670             my $user_obj = RT::User->new(RT->SystemUser);
 671             $user_obj->LoadByEmail($rcpt);
 672             if  ( ! $user_obj->id ) {
 673                 # If there's an email address in here without an associated
 674                 # RT user, pass it on through.
 675                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
 676                 push( @send_now, $rcpt );
 677                 next;
 678             }
 679
 680             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
 681             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
 682
 683             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
 684             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
 685             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
 686             else { push( @send_now, $rcpt ) }
 687         }
 688
 689         # Reset the relevant mail field.
 690         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
 691         if (@send_now) {
 692             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
 693         } else {    # No recipients!  Remove the header.
 694             $self->TemplateObj->MIMEObj->head->delete($mailfield);
 695         }
 696
 697         # Push the deferred addresses into the appropriate field in
 698         # our attribute hash, with the appropriate mail header.
 699         $RT::Logger->debug(
 700             "Setting deferred recipients for attribute creation");
 701         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
 702         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
 703         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
 704     }
 705
 706     if ( scalar keys %$digest_hash ) {
 707
 708         # Save the hash so that we can add it as an attribute to the
 709         # outgoing email transaction.
 710         $self->{'Deferred'} = $digest_hash;
 711     } else {
 712         $RT::Logger->debug( "No recipients found for deferred delivery on "
 713                 . "transaction #"
 714                 . $self->TransactionObj->id );
 715     }
 716 }
 717
 718
 719
 720 sub RecordDeferredRecipients {
 721     my $self = shift;
 722     return unless exists $self->{'Deferred'};
 723
 724     my $txn_id = $self->{'OutgoingMailTransaction'};
 725     return unless $txn_id;
 726
 727     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
 728     $txn_obj->Load( $txn_id );
 729     my( $ret, $msg ) = $txn_obj->AddAttribute(
 730         Name => 'DeferredRecipients',
 731         Content => $self->{'Deferred'}
 732     );
 733     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
 734         unless $ret;
 735
 736     return ($ret,$msg);
 737 }
 738
 739 =head2 SquelchMailTo
 740
 741 Returns list of the addresses to squelch on this transaction.
 742
 743 =cut
 744
 745 sub SquelchMailTo {
 746     my $self = shift;
 747     return map $_->Content, $self->TransactionObj->SquelchMailTo;
 748 }
 749
 750 =head2 RemoveInappropriateRecipients
 751
 752 Remove addresses that are RT addresses or that are on this transaction's blacklist
 753
 754 =cut
 755
 756 sub RemoveInappropriateRecipients {
 757     my $self = shift;
 758
 759     my @blacklist = ();
 760
 761     # If there are no recipients, don't try to send the message.
 762     # If the transaction has content and has the header RT-Squelch-Replies-To
 763
 764     my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
 765     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 766
 767         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
 768
 769             # What do we want to do with this? It's probably (?) a bounce
 770             # caused by one of the watcher addresses being broken.
 771             # Default ("true") is to redistribute, for historical reasons.
 772
 773             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
 774
 775                 # Don't send to any watchers.
 776                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
 777                 $RT::Logger->info( $msgid
 778                         . " The incoming message was autogenerated. "
 779                         . "Not redistributing this message based on site configuration."
 780                 );
 781             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
 782                 'privileged' )
 783             {
 784
 785                 # Only send to "privileged" watchers.
 786                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 787                     foreach my $addr ( @{ $self->{$type} } ) {
 788                         my $user = RT::User->new(RT->SystemUser);
 789                         $user->LoadByEmail($addr);
 790                         push @blacklist, $addr unless $user->id && $user->Privileged;
 791                     }
 792                 }
 793                 $RT::Logger->info( $msgid
 794                         . " The incoming message was autogenerated. "
 795                         . "Not redistributing this message to unprivileged users based on site configuration."
 796                 );
 797             }
 798         }
 799
 800         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
 801             push @blacklist, split( /,/, $squelch );
 802         }
 803     }
 804
 805     # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
 806     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
 807
 808     # Cycle through the people we're sending to and pull out anyone on the
 809     # system blacklist
 810
 811     # Trim leading and trailing spaces.
 812     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
 813         Email::Address->parse( join ', ', grep defined, @blacklist );
 814
 815     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 816         my @addrs;
 817         foreach my $addr ( @{ $self->{$type} } ) {
 818
 819          # Weed out any RT addresses. We really don't want to talk to ourselves!
 820          # If we get a reply back, that means it's not an RT address
 821             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 822                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 823                 next;
 824             }
 825             if ( grep $addr eq $_, @blacklist ) {
 826                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
 827                 next;
 828             }
 829             push @addrs, $addr;
 830         }
 831         foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
 832             # never send email to itself
 833             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 834                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 835                 next;
 836             }
 837             push @addrs, $addr;
 838         }
 839         @{ $self->{$type} } = @addrs;
 840     }
 841 }
 842
 843 =head2 SetReturnAddress is_comment => BOOLEAN
 844
 845 Calculate and set From and Reply-To headers based on the is_comment flag.
 846
 847 =cut
 848
 849 sub SetReturnAddress {
 850
 851     my $self = shift;
 852     my %args = (
 853         is_comment => 0,
 854         friendly_name => undef,
 855         @_
 856     );
 857
 858     # From and Reply-To
 859     # $args{is_comment} should be set if the comment address is to be used.
 860     my $replyto;
 861
 862     if ( $args{'is_comment'} ) {
 863         $replyto = $self->TicketObj->QueueObj->CommentAddress
 864             || RT->Config->Get('CommentAddress');
 865     } else {
 866         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 867             || RT->Config->Get('CorrespondAddress');
 868     }
 869
 870     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 871         $self->SetFrom( %args, From => $replyto );
 872     }
 873
 874     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 875         $self->SetHeader( 'Reply-To', "$replyto" );
 876     }
 877
 878 }
 879
 880 =head2 SetFrom ( From => emailaddress )
 881
 882 Set the From: address for outgoing email
 883
 884 =cut
 885
 886 sub SetFrom {
 887     my $self = shift;
 888     my %args = @_;
 889
 890     if ( RT->Config->Get('UseFriendlyFromLine') ) {
 891         my $friendly_name = $self->GetFriendlyName(%args);
 892         $self->SetHeader(
 893             'From',
 894             sprintf(
 895                 RT->Config->Get('FriendlyFromLineFormat'),
 896                 $self->MIMEEncodeString(
 897                     $friendly_name, RT->Config->Get('EmailOutputEncoding')
 898                 ),
 899                 $args{From}
 900             ),
 901         );
 902     } else {
 903         $self->SetHeader( 'From', $args{From} );
 904     }
 905 }
 906
 907 =head2 GetFriendlyName
 908
 909 Calculate the proper Friendly Name based on the creator of the transaction
 910
 911 =cut
 912
 913 sub GetFriendlyName {
 914     my $self = shift;
 915     my %args = (
 916         is_comment => 0,
 917         friendly_name => '',
 918         @_
 919     );
 920     my $friendly_name = $args{friendly_name};
 921
 922     unless ( $friendly_name ) {
 923         $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 924         if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 925             $friendly_name = $1;
 926         }
 927     }
 928
 929     $friendly_name =~ s/"/\\"/g;
 930     return $friendly_name;
 931
 932 }
 933
 934 =head2 SetHeader FIELD, VALUE
 935
 936 Set the FIELD of the current MIME object into VALUE.
 937
 938 =cut
 939
 940 sub SetHeader {
 941     my $self  = shift;
 942     my $field = shift;
 943     my $val   = shift;
 944
 945     chomp $val;
 946     chomp $field;
 947     my $head = $self->TemplateObj->MIMEObj->head;
 948     $head->fold_length( $field, 10000 );
 949     $head->replace( $field, $val );
 950     return $head->get($field);
 951 }
 952
 953 =head2 SetSubject
 954
 955 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
 956 If subject is already defined via template, it uses that. otherwise, it tries to get
 957 the transaction's subject.
 958
 959 =cut
 960
 961 sub SetSubject {
 962     my $self = shift;
 963     my $subject;
 964
 965     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 966         return ();
 967     }
 968
 969     # don't use Transaction->Attachments because it caches
 970     # and anything which later calls ->Attachments will be hurt
 971     # by our RowsPerPage() call.  caching is hard.
 972     my $message = RT::Attachments->new( $self->CurrentUser );
 973     $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
 974     $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 975     $message->RowsPerPage(1);
 976
 977     if ( $self->{'Subject'} ) {
 978         $subject = $self->{'Subject'};
 979     } elsif ( my $first = $message->First ) {
 980         my $tmp = $first->GetHeader('Subject');
 981         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
 982     } else {
 983         $subject = $self->TicketObj->Subject;
 984     }
 985     $subject = '' unless defined $subject;
 986     chomp $subject;
 987
 988     $subject =~ s/(\r\n|\n|\s)/ /g;
 989
 990     $self->SetHeader( 'Subject', $subject );
 991
 992 }
 993
 994 =head2 SetSubjectToken
 995
 996 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 997
 998 =cut
 999
1000 sub SetSubjectToken {
1001     my $self = shift;
1002
1003     my $head = $self->TemplateObj->MIMEObj->head;
1004     $head->replace(
1005         Subject => RT::Interface::Email::AddSubjectTag(
1006             Encode::decode_utf8( $head->get('Subject') ),
1007             $self->TicketObj,
1008         ),
1009     );
1010 }
1011
1012 =head2 SetReferencesHeaders
1013
1014 Set References and In-Reply-To headers for this message.
1015
1016 =cut
1017
1018 sub SetReferencesHeaders {
1019     my $self = shift;
1020
1021     my $top = $self->TransactionObj->Message->First;
1022     unless ( $top ) {
1023         $self->SetHeader( References => $self->PseudoReference );
1024         return (undef);
1025     }
1026
1027     my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1028     my @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
1029     my @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
1030
1031     # There are two main cases -- this transaction was created with
1032     # the RT Web UI, and hence we want to *not* append its Message-ID
1033     # to the References and In-Reply-To.  OR it came from an outside
1034     # source, and we should treat it as per the RFC
1035     my $org = RT->Config->Get('Organization');
1036     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1037
1038         # Make all references which are internal be to version which we
1039         # have sent out
1040
1041         for ( @references, @in_reply_to ) {
1042             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1043           "<$1." . $self->TicketObj->id .
1044              "-" . $self->ScripObj->id .
1045              "-" . $self->ScripActionObj->{_Message_ID} .
1046              "@" . $org . ">"/eg
1047         }
1048
1049         # In reply to whatever the internal message was in reply to
1050         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1051
1052         # Default the references to whatever we're in reply to
1053         @references = @in_reply_to unless @references;
1054
1055         # References are unchanged from internal
1056     } else {
1057
1058         # In reply to that message
1059         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1060
1061         # Default the references to whatever we're in reply to
1062         @references = @in_reply_to unless @references;
1063
1064         # Push that message onto the end of the references
1065         push @references, @msgid;
1066     }
1067
1068     # Push pseudo-ref to the front
1069     my $pseudo_ref = $self->PseudoReference;
1070     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1071
1072     # If there are more than 10 references headers, remove all but the
1073     # first four and the last six (Gotta keep this from growing
1074     # forever)
1075     splice( @references, 4, -6 ) if ( $#references >= 10 );
1076
1077     # Add on the references
1078     $self->SetHeader( 'References', join( " ", @references ) );
1079     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1080
1081 }
1082
1083 =head2 PseudoReference
1084
1085 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1086
1087 =cut
1088
1089 sub PseudoReference {
1090
1091     my $self = shift;
1092     my $pseudo_ref
1093         = '<RT-Ticket-'
1094         . $self->TicketObj->id . '@'
1095         . RT->Config->Get('Organization') . '>';
1096     return $pseudo_ref;
1097 }
1098
1099 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1100
1101 This routine converts the field into specified charset encoding.
1102
1103 =cut
1104
1105 sub SetHeaderAsEncoding {
1106     my $self = shift;
1107     my ( $field, $enc ) = ( shift, shift );
1108
1109     my $head = $self->TemplateObj->MIMEObj->head;
1110
1111     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1112         $head->replace( $field, RT->Config->Get('SMTPFrom') );
1113         return;
1114     }
1115
1116     my $value = $head->get( $field );
1117     $value = $self->MIMEEncodeString( $value, $enc );
1118     $head->replace( $field, $value );
1119
1120 }
1121
1122 =head2 MIMEEncodeString
1123
1124 Takes a perl string and optional encoding pass it over
1125 L<RT::Interface::Email/EncodeToMIME>.
1126
1127 Basicly encode a string using B encoding according to RFC2047.
1128
1129 =cut
1130
1131 sub MIMEEncodeString {
1132     my $self  = shift;
1133     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1134 }
1135
1136 RT::Base->_ImportOverlays();
1137
1138 1;
1139